CDE

Task/Call-a-foreign-language-function/0DESCRIPTION

@@ -0,0 +1,11 @@
+Show how a [[Foreign function interface|foreign language function]] can be called from the language.
+
+As an example, consider calling functions defined in the [[C]] language. Create a string containing "Hello World!" of the string type typical to the language. Pass the string content to [[C]]'s <code>strdup</code>. The content can be copied if necessary. Get the result from <code>strdup</code> and print it using language means. Do not forget to free the result of <code>strdup</code> (allocated in the heap).
+
+Notes:
+* It is not mandated if the [[C]] run-time library is to be loaded statically or dynamically. You are free to use either way.
+* [[C++]] and [[C]] solutions can take some other language to communicate with.
+* It is ''not'' mandatory to use <code>strdup</code>, especially if the foreign function interface being demonstrated makes that uninformative.
+
+See also:
+* [[Use another language to call a function]]

Task/Call-a-foreign-language-function/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Programming environment operations

Task/Call-a-foreign-language-function/Ada/call-a-foreign-language-function.ada

@@ -0,0 +1,15 @@
+with Ada.Text_IO;           use Ada.Text_IO;
+with Interfaces.C;          use Interfaces.C;
+with Interfaces.C.Strings;  use Interfaces.C.Strings;
+
+procedure Test_C_Interface is
+   function strdup (s1 : Char_Array) return Chars_Ptr;
+   pragma Import (C, strdup, "_strdup");
+
+   S1 : constant String := "Hello World!";
+   S2 : Chars_Ptr;
+begin
+   S2 := strdup (To_C (S1));
+   Put_Line (Value (S2));
+   Free (S2);
+end Test_C_Interface;

Task/Call-a-foreign-language-function/Aikido/call-a-foreign-language-function-1.aikido

@@ -0,0 +1,13 @@
+#include <aikido.h>
+extern "C" {       // need C linkage
+
+// define the function using a macro defined in aikido.h
+AIKIDO_NATIVE(strdup) {
+    aikido::string *s = paras[0].str;
+    char *p = strdup (s->c_str());
+    aikido::string *result = new aikido::string(p);
+    free (p);
+    return result;
+}
+
+}

Task/Call-a-foreign-language-function/Aikido/call-a-foreign-language-function-2.aikido

@@ -0,0 +1,2 @@
+native function strdup(s)
+println (strdup ("Hello World!"))

Task/Call-a-foreign-language-function/Aikido/call-a-foreign-language-function-3.aikido

@@ -0,0 +1,14 @@
+native function strdup (s)  // declare native
+native function free(p)    // also need to free the result
+
+var s = strdup ("hello world\n")
+var p = s     // this is an integer type
+for (;;) {
+    var ch = peek (p, 1)   // read a single character
+    if (ch == 0) {
+        break
+    }
+    print (cast<char>(ch))   // print as a character
+    p++
+}
+free (s)   // done with the memory now

Task/Call-a-foreign-language-function/AutoHotkey/call-a-foreign-language-function.ahk

@@ -0,0 +1,4 @@
+; Example: Calls the Windows API function "MessageBox" and report which button the user presses.
+
+WhichButton := DllCall("MessageBox", "int", "0", "str", "Press Yes or No", "str", "Title of box", "int", 4)
+MsgBox You pressed button #%WhichButton%.

Task/Call-a-foreign-language-function/BBC-BASIC/call-a-foreign-language-function.bbc

@@ -0,0 +1,7 @@
+      SYS "LoadLibrary", "MSVCRT.DLL" TO msvcrt%
+      SYS "GetProcAddress", msvcrt%, "_strdup" TO `strdup`
+      SYS "GetProcAddress", msvcrt%, "free" TO `free`
+
+      SYS `strdup`, "Hello World!" TO address%
+      PRINT $$address%
+      SYS `free`, address%

Task/Call-a-foreign-language-function/C++/call-a-foreign-language-function-1.cpp

@@ -0,0 +1,2 @@
+FUNCTION MULTIPLY(X, Y)
+DOUBLE PRECISION MULTIPLY, X, Y

Task/Call-a-foreign-language-function/C++/call-a-foreign-language-function-2.cpp

@@ -0,0 +1,42 @@
+#include <cstdlib>  // for C memory management
+#include <string>   // for C++ strings
+#include <iostream> // for output
+
+// C functions must be defined extern "C"
+extern "C" char* strdup1(char const*);
+
+// Fortran functions must also be defined extern "C" to prevent name
+// mangling; in addition, all fortran names are converted to lowercase
+// and get an undescore appended. Fortran takes all arguments by
+// reference, which translates to pointers in C and C++ (C++
+// references generally work, too, but that may depend on the C++
+// compiler)
+extern "C" double multiply_(double* x, double* y);
+
+// to simplify the use and reduce the probability of errors, a simple
+// inline forwarder like this can be used:
+inline double multiply(double x, double y)
+{
+  return multiply_(&x, &y);
+}
+
+int main()
+{
+  std::string msg = "The product of 3 and 5 is ";
+
+  // call to C function (note that this should not be assigned
+  // directly to a C++ string, because strdup1 allocates memory, and
+  // we would leak the memory if we wouldn't save the pointer itself
+  char* msg2 = strdup1(msg.c_str());
+
+  // C strings can be directly output to std::cout, so we don't need
+  // to put it back into a string to output it.
+  std::cout << msg2;
+
+  // call the FORTRAN function (through the wrapper):
+  std::cout << multiply(3, 5) << std::endl;
+
+  // since strdup1 allocates with malloc, it must be deallocated with
+  // free, not delete, nor delete[], nor operator delete
+  std::free(msg2);
+}

Task/Call-a-foreign-language-function/CMake/call-a-foreign-language-function-1.cmake

@@ -0,0 +1,25 @@
+cmake_minimum_required(VERSION 2.6)
+project("outer project" C)
+
+# Compile cmDIV.
+try_compile(
+  compiled_div                  # result variable
+  ${CMAKE_BINARY_DIR}/div       # bindir
+  ${CMAKE_SOURCE_DIR}/div       # srcDir
+  div)                          # projectName
+if(NOT compiled_div)
+  message(FATAL_ERROR "Failed to compile cmDIV")
+endif()
+
+# Load cmDIV.
+load_command(DIV ${CMAKE_BINARY_DIR}/div)
+if(NOT CMAKE_LOADED_COMMAND_DIV)
+  message(FATAL_ERROR "Failed to load cmDIV")
+endif()
+
+# Try div() command.
+div(quot rem 2012 500)
+message("
+  2012 / 500 = ${quot}
+  2012 % 500 = ${rem}
+")

Task/Call-a-foreign-language-function/CMake/call-a-foreign-language-function-2.cmake

@@ -0,0 +1,8 @@
+cmake_minimum_required(VERSION 2.6)
+project(div C)
+
+# Find cmCPluginAPI.h
+include_directories(${CMAKE_ROOT}/include)
+
+# Compile cmDIV from div-command.c
+add_library(cmDIV MODULE div-command.c)

Task/Call-a-foreign-language-function/CMake/call-a-foreign-language-function-3.cmake

@@ -0,0 +1,55 @@
+#include <cmCPluginAPI.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+static cmCAPI *api;
+
+/*
+ * Respond to DIV(quotient remainder numerator denominator).
+ */
+static int
+initial_pass(void *info, void *mf, int argc, char *argv[])
+{
+	div_t answer;
+	int count, i, j, n[2];
+	char buf[512], c;
+
+	if (argc != 4) {
+		api->SetError(info, "Wrong number of arguments");
+		return 0;  /* failure */
+	}
+
+	/* Parse numerator and denominator. */
+	for(i = 2, j = 0; i < 4; i++, j++) {
+		count = sscanf(argv[i], "%d%1s", &n[j], c);
+		if (count != 1) {
+			snprintf(buf, sizeof buf,
+			    "Not an integer: %s", argv[i]);
+			api->SetError(info, buf);
+			return 0;  /* failure */
+		}
+	}
+
+	/* Call div(). */
+	if (n[1] == 0) {
+		api->SetError(info, "Division by zero");
+		return 0;  /* failure */
+	}
+	answer = div(n[0], n[1]);
+
+	/* Set variables to answer. */
+	snprintf(buf, sizeof buf, "%d", answer.quot);
+	api->AddDefinition(mf, argv[0], buf);
+	snprintf(buf, sizeof buf, "%d", answer.rem);
+	api->AddDefinition(mf, argv[1], buf);
+
+	return 1;  /* success */
+}
+
+CM_PLUGIN_EXPORT void
+DIVInit(cmLoadedCommandInfo *info)
+{
+	info->Name = "DIV";
+	info->InitialPass = initial_pass;
+	api = info->CAPI;
+}

Task/Call-a-foreign-language-function/Common-Lisp/call-a-foreign-language-function.lisp

@@ -0,0 +1,7 @@
+CL-USER> (let* ((string "Hello World!")
+                (c-string (cffi:foreign-funcall "strdup" :string string :pointer)))
+           (unwind-protect (write-line (cffi:foreign-string-to-lisp c-string))
+             (cffi:foreign-funcall "free" :pointer c-string :void))
+           (values))
+Hello World!
+; No value

Task/Call-a-foreign-language-function/D/call-a-foreign-language-function.d

@@ -0,0 +1,36 @@
+import std.stdio: writeln;
+import std.string: toStringz;
+import std.conv: to;
+
+extern(C) {
+    char* strdup(in char* s1);
+    void free(void* ptr);
+}
+
+void main() {
+    // We could use char* here (as in D string literals are
+    // null-terminated) but we want to comply with the "of the
+    // string type typical to the language" part.
+    // Note: D supports 0-values inside a string, C doesn't.
+    auto input = "Hello World!";
+
+    // Method 1 (preferred):
+    //   toStringz converts D strings to null-terminated C strings.
+    char* str1 = strdup(toStringz(input));
+
+    // Method 2:
+    // D strings are not null-terminated, so we append '\0'.
+    // .ptr returns a pointer to the 1st element of the array,
+    // just as &array[0]
+    // This has to be done because D dynamic arrays are
+    // represented with:  { size_t length; T* pointer; }
+    char* str2 = strdup((input ~ '\0').ptr);
+
+    // We could have just used printf here, but the task asks to
+    // "print it using language means":
+    writeln("str1: ", to!string(str1));
+    writeln("str2: ", to!string(str2));
+
+    free(str1);
+    free(str2);
+}

Task/Call-a-foreign-language-function/Delphi/call-a-foreign-language-function-1.delphi

@@ -0,0 +1 @@
+{$O myhello.obj}

Task/Call-a-foreign-language-function/Delphi/call-a-foreign-language-function-2.delphi

@@ -0,0 +1 @@
+procedure Hello(S: PChar); stdcall; external;

Task/Call-a-foreign-language-function/Forth/call-a-foreign-language-function.fth

@@ -0,0 +1,23 @@
+c-library cstrings
+
+\c #include <string.h>
+c-function strdup strdup a -- a ( c-string -- duped string )
+c-function strlen strlen a -- n ( c-string -- length )
+
+end-c-library
+
+\ convenience function (not used here)
+: c-string ( addr u -- addr' )
+    tuck  pad swap move  pad + 0 swap c!  pad ;
+
+create test s" testing" mem, 0 c,
+
+test strdup value duped
+
+test .
+test 7 type		\ testing
+cr
+duped .                 \ different address
+duped dup strlen type   \ testing
+
+duped free throw	\ gforth ALLOCATE and FREE map directly to C's malloc() and free()

Task/Call-a-foreign-language-function/Go/call-a-foreign-language-function.go

@@ -0,0 +1,28 @@
+package main
+
+// #include <string.h>
+// #include <stdlib.h>
+import "C"
+import (
+    "fmt"
+    "unsafe"
+)
+
+func main() {
+    // a go string
+    go1 := "hello C"
+    // allocate in C and convert from Go representation to C representation
+    c1 := C.CString(go1)
+    // go string can now be garbage collected
+    go1 = ""
+    // strdup, per task. this calls the function in the C library.
+    c2 := C.strdup(c1)
+    // free the source C string.  again, this is free() in the C library.
+    C.free(unsafe.Pointer(c1))
+    // create a new Go string from the C copy
+    go2 := C.GoString(c2)
+    // free the C copy
+    C.free(unsafe.Pointer(c2))
+    // demonstrate we have string contents intact
+    fmt.Println(go2)
+}

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-1.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Foreign (free)
+import Foreign.C.String (CString, withCString, peekCString)
+
+-- import the strdup function itself
+-- the "unsafe" means "assume this foreign function never calls back into Haskell and avoid extra bookkeeping accordingly"
+foreign import ccall unsafe "string.h strdup" strdup :: CString -> IO CString
+
+testC = withCString "Hello World!" -- marshall the Haskell string "Hello World!" into a C string...
+        (\s -> -- ... and name it s
+         do s2 <- strdup s
+            s2_hs <- peekCString s2 -- marshall the C string called s2 into a Haskell string named s2_hs
+            putStrLn s2_hs
+            free s2) -- s is automatically freed by withCString once done

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-2.hs

@@ -0,0 +1,18 @@
+#include <string.h>
+#include "icall.h"  // a header routine from the Unicon sources - provides helpful type-conversion macros
+
+int strdup_wrapper (int argc, descriptor *argv)
+{
+  ArgString (1); // check that the first argument is a string
+
+  RetString (strdup (StringVal(argv[1]))); // call strdup, convert and return result
+}
+
+// and strcat, for a result that does not equal the input
+int strcat_wrapper (int argc, descriptor *argv)
+{
+  ArgString (1);
+  ArgString (2);
+  char * result = strcat (StringVal(argv[1]), StringVal(argv[2]));
+  RetString (result);
+}

Task/Call-a-foreign-language-function/Haskell/call-a-foreign-language-function-3.hs

@@ -0,0 +1,23 @@
+$define LIB "libstrdup-wrapper.so"
+
+# the unicon wrapper to access the C function
+procedure strdup (str)
+  static f
+  initial {
+    f := loadfunc (LIB, "strdup_wrapper") // pick out the wrapped function from the shared library
+  }
+  return f(str) // call the wrapped function
+end
+
+procedure strcat (str1, str2)
+  static f
+  initial {
+    f := loadfunc (LIB, "strcat_wrapper")
+  }
+  return f(str1, str2)
+end
+
+procedure main ()
+  write (strdup ("abc"))
+  write (strcat ("abc", "def"))
+end

Task/Call-a-foreign-language-function/Java/call-a-foreign-language-function-1.java

@@ -0,0 +1,12 @@
+public class JNIDemo
+{
+  static
+  {  System.loadLibrary("JNIDemo");  }
+
+  public static void main(String[] args)
+  {
+    System.out.println(callStrdup("Hello World!"));
+  }
+
+  private static native String callStrdup(String s);
+}

Task/Call-a-foreign-language-function/Java/call-a-foreign-language-function-2.java

@@ -0,0 +1,21 @@
+/* DO NOT EDIT THIS FILE - it is machine generated */
+#include <jni.h>
+/* Header for class JNIDemo */
+
+#ifndef _Included_JNIDemo
+#define _Included_JNIDemo
+#ifdef __cplusplus
+extern "C" {
+#endif
+/*
+ * Class:     JNIDemo
+ * Method:    callStrdup
+ * Signature: (Ljava/lang/String;)Ljava/lang/String;
+ */
+JNIEXPORT jstring JNICALL Java_JNIDemo_callStrdup
+  (JNIEnv *, jclass, jstring);
+
+#ifdef __cplusplus
+}
+#endif
+#endif

Task/Call-a-foreign-language-function/Java/call-a-foreign-language-function-3.java

@@ -0,0 +1,43 @@
+#include "string.h"
+#include "JNIDemo.h"
+
+void throwByName(JNIEnv* env, const char* className, const char* msg)
+{
+  jclass exceptionClass = (*env)->FindClass(env, className);
+  if (exceptionClass != NULL)
+  {
+    (*env)->ThrowNew(env, exceptionClass, msg);
+    (*env)->DeleteLocalRef(env, exceptionClass);
+  }
+  return;
+}
+
+JNIEXPORT jstring JNICALL Java_JNIDemo_callStrdup(JNIEnv *env, jclass cls, jstring s)
+{
+  const jbyte* utf8String;
+  char* dupe;
+  jstring dupeString;
+
+  if (s == NULL)
+  {
+    throwByName(env, "java/lang/NullPointerException", "String is null");
+    return NULL;
+  }
+
+  // Convert from UTF-16 to UTF-8 (C-style)
+  utf8String = (*env)->GetStringUTFChars(env, s, NULL);
+
+  // Duplicate
+  dupe = strdup(utf8String);
+
+  // Free the UTF-8 string back to the JVM
+  (*env)->ReleaseStringUTFChars(env, s, utf8String);
+
+  // Convert the duplicate string from strdup to a Java String
+  dupeString = (*env)->NewStringUTF(env, dupe);
+
+  // Free the duplicate c-string back to the C runtime heap
+  free(dupe);
+
+  return dupeString;
+}

Task/Call-a-foreign-language-function/Perl/call-a-foreign-language-function-1.pl

@@ -0,0 +1,11 @@
+use Inline C => q{
+    char *copy;
+    char * c_dup(char *orig) {
+        return copy = strdup(orig);
+    }
+    void c_free() {
+        free(copy);
+    }
+};
+print c_dup('Hello'), "\n";
+c_free();

Task/Call-a-foreign-language-function/Perl/call-a-foreign-language-function-2.pl

@@ -0,0 +1,8 @@
+use Inline C => q{
+    void c_hello (char *text) {
+        char *copy = strdup(text);
+        printf("Hello, %s!\n", copy);
+        free(copy);
+    }
+};
+c_hello 'world';

Task/Call-a-foreign-language-function/PicoLisp/call-a-foreign-language-function-1.l

@@ -0,0 +1,19 @@
+(load "@lib/gcc.l")
+
+(gcc "str" NIL                # The 'gcc' function passes all text
+   'duptest )                 # until /**/ to the C compiler
+
+any duptest(any ex) {
+   any x = evSym(cdr(ex));    // Accept a symbol (string)
+   char str[bufSize(x)];      // Create a buffer to unpack the name
+   char *s;
+
+   bufString(x, str);         // Upack the string
+   s = strdup(str);           // Make a duplicate
+   x = mkStr(s);              // Build a new Lisp string
+   free(s);                   // Dispose the duplicate
+   return x;
+}
+/**/
+
+(println 'Duplicate (duptest "Hello world!"))

Task/Call-a-foreign-language-function/PicoLisp/call-a-foreign-language-function-2.l

@@ -0,0 +1,17 @@
+(load "@lib/native.l")
+
+(gcc "str" NIL
+   (duptest (Str) duptest 'S Str) )
+
+#include <stdlib.h>
+#include <string.h>
+
+char *duptest(char *str) {
+   static char *s;
+
+   free(s);    // We simply dispose the result of the last call
+   return s = strdup(str);
+}
+/**/
+
+(println 'Duplicate (duptest "Hello world!"))

Task/Call-a-foreign-language-function/Python/call-a-foreign-language-function.py

@@ -0,0 +1,4 @@
+import ctypes
+libc = ctypes.CDLL("/lib/libc.so.6")
+libc.strcmp("abc", "def")     # -1
+libc.strcmp("hello", "hello") #  0

Task/Call-a-foreign-language-function/Racket/call-a-foreign-language-function.rkt

@@ -0,0 +1,41 @@
+#lang racket/base
+(require ffi/unsafe)
+
+(provide strdup)
+
+;; Helper: create a Racket string from a C string pointer.
+(define make-byte-string
+  (get-ffi-obj "scheme_make_byte_string" #f (_fun _pointer -> _scheme)))
+
+;; Take special care not to allow NULL (#f) to be passed as an input,
+;; as that will crash strdup.
+(define _string/no-null
+  (make-ctype _pointer
+    (lambda (x)
+      (unless (string? x)
+        (raise-argument-error '_string/no-null "string" x))
+      (string->bytes/utf-8 x))
+    ;; We don't use _string/no-null as an output type, so don't care:
+    (lambda (x) x)))
+
+; Make a Scheme string from the C string, and free immediately.
+(define _string/free
+  (make-ctype _pointer
+    ;; We don't use this as an input type, so we don't care.
+    (lambda (x) x)
+    (lambda (x)
+      (cond
+       [x
+        (define s (bytes->string/utf-8 (make-byte-string x)))
+        (free x)
+        s]
+       [else
+        ;; We should never get null from strdup unless we're out of
+        ;; memory:
+        (error 'string/free "Out of memory")]))))
+
+(define strdup
+  (get-ffi-obj "strdup" #f (_fun _string/no-null -> _string/free)))
+
+;; Let's try it:
+(strdup "Hello World!")

Task/Call-a-foreign-language-function/Ruby/call-a-foreign-language-function-1.rb

@@ -0,0 +1,14 @@
+require 'ffi'
+
+module LibC
+  extend FFI::Library
+  ffi_lib FFI::Platform::LIBC
+
+  attach_function :strdup, [:string], :pointer
+  attach_function :free, [:pointer], :void
+end
+
+string = "Hello, World!"
+duplicate = LibC.strdup(string)
+puts duplicate.get_string(0)
+LibC.free(duplicate)

Task/Call-a-foreign-language-function/Ruby/call-a-foreign-language-function-2.rb

@@ -0,0 +1,19 @@
+require 'dl'
+require 'fiddle'
+
+# Declare strdup().
+#  * DL::Handle['strdup'] is the address of the function.
+#  * The function takes a pointer and returns a pointer.
+strdup = Fiddle::Function.new(DL::Handle['strdup'],
+                              [DL::TYPE_VOIDP], DL::TYPE_VOIDP)
+
+# Call strdup().
+#  * Fiddle converts our Ruby string to a C string.
+#  * Fiddle returns a DL::CPtr.
+duplicate = strdup.call("This is a string!")
+
+# DL::CPtr#to_s converts our C string to a Ruby string.
+puts duplicate.to_s
+
+# We must call free(), because strdup() allocated memory.
+DL.free duplicate

Task/Call-a-foreign-language-function/Ruby/call-a-foreign-language-function-3.rb

@@ -0,0 +1,33 @@
+require 'rubygems'
+require 'inline'
+
+class InlineTester
+  def factorial_ruby(n)
+    (1..n).inject(1, :*)
+  end
+
+  inline do |builder|
+    builder.c <<-'END_C'
+      long factorial_c(int max) {
+        long result = 1;
+        int i;
+        for (i = 1; i <= max; ++i)
+          result *= i;
+        return result;
+      }
+    END_C
+  end
+
+  inline do |builder|
+    builder.include %q("math.h")
+    builder.c <<-'END_C'
+      int my_ilogb(double value) {
+        return ilogb(value);
+      }
+    END_C
+  end
+end
+
+t = InlineTester.new
+11.upto(14) {|n| p [n, t.factorial_ruby(n), t.factorial_c(n)]}
+p t.my_ilogb(1000)

Task/Call-a-foreign-language-function/Tcl/call-a-foreign-language-function.tcl

@@ -0,0 +1,8 @@
+package require critcl
+critcl::code {
+    #include <math.h>
+}
+critcl::cproc tcl::mathfunc::ilogb {double value} int {
+    return ilogb(value);
+}
+package provide ilogb 1.0