Call a foreign-language function

Call a foreign-language function
You are encouraged to solve this task according to the task description, using any language you may know.

Show how a 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 strdup. The content can be copied if necessary. Get the result from strdup and print it using language means. Do not forget to free the result of strdup (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 strdup, especially if the foreign function interface being demonstrated makes that uninformative.

See also:

• Use another language to call a function

ALGOL 68

The designers of Algol 68 made it extremely hard to incorporate code written in other languages. To be fair, this was a long time ago when such considerations weren't thought important and one should be careful to apply Hanlon's razor.

The entry below is wildly non-portable, inefficient, violates the spirit of the specification and is just plain sick. However, it gives the correct results with Algol 68 Genie on Linux and, I claim, meets the letter of the spec. It also omits most of the error checking which should be present in production code.

Note that I chose a non-trivial library function because the suggested strdup() doesn't really demonstrate the technique all that well. <lang algol68> BEGIN

  MODE PASSWD = STRUCT (STRING name, passwd, INT uid, gid, STRING gecos, dir, shell);
  PROC getpwnam = (STRING name) PASSWD :
  BEGIN
     FILE c source;
     create (c source, stand out channel);
     putf (c source, ($gl$,

"#include <sys/types.h>", "#include <pwd.h>", "#include <stdio.h>", "main ()", "{", " char name[256];", " scanf (""%s"", name);", " struct passwd *pass = getpwnam (name);", " if (pass == (struct passwd *) NULL) {", " putchar ('\n');", " } else {", " printf (""%s\n"", pass->pw_name);", " printf (""%s\n"", pass->pw_passwd);", " printf (""%d\n"", pass->pw_uid);", " printf (""%d\n"", pass->pw_gid);", " printf (""%s\n"", pass->pw_gecos);", " printf (""%s\n"", pass->pw_dir);", " printf (""%s\n"", pass->pw_shell);", " }", "}" ));

     STRING source name = idf (c source);
     STRING bin name = source name + ".bin";
     INT child pid = execve child ("/usr/bin/gcc",

("gcc", "-x", "c", source name, "-o", bin name), "");

     wait pid (child pid);
     PIPE p = execve child pipe (bin name, "Ding dong, a68g calling", "");
     put (write OF p, (name, newline));
     STRING line;
     PASSWD result;
     IF get (read OF p, (line, newline)); line = ""
     THEN

result := ("", "", -1, -1, "", "", "") CO

        Return to sender, address unknown.
        No such number, no such zone.

CO

     ELSE

name OF result := line; get (read OF p, (passwd OF result, newline)); get (read OF p, (uid OF result, newline)); get (read OF p, (gid OF result, newline)); get (read OF p, (gecos OF result, newline)); get (read OF p, (dir OF result, newline)); get (read OF p, (shell OF result, newline))

     FI;
     close (write OF p);			CO Sundry cleaning up. CO
     close (read OF p);
     execve child ("/bin/rm", ("rm", "-f", source name, bin name), "");
     result
  END;
  PASSWD mr root = getpwnam ("root");
  IF name OF mr root = ""
  THEN
     print (("Oh dear, we seem to be rootless.", newline))
  ELSE
     printf (($2(g,":"), 2(g(0),":"), 2(g,":"), gl$, mr root))
  FI

END </lang>

Output:

root:x:0:0:root:/root:/bin/bash

8th

<lang forth> \ tell 8th what the function expects: "ZZ" "strdup" func: strdup "VZ" "free" func: free \ call the external funcs "abc" dup \ now we have two strings "abc" on the stack strdup .s cr \ after strdup, you'll have the new (but duplicate) string on the stack \ the ".s" will show both strings and you can see they are different items on the stack free \ let the c library free the string </lang>

Ada

Ada provides standard interfaces to C, C++, Fortran and Cobol. Other language interfaces can be provided as well, but are not mandatory. Usually it is possible to communicate to any language that supports calling conventions standard to the OS (cdecl, stdcall etc). <lang Ada>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;</lang>

Aikido

There are two ways to call a native function in Aikido. The first is to write a wrapper function in C++ that is invoked from the Aikido interpreter. In a C++ file: <lang aikido>#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;

}

}</lang>

Then in the Aikido program: <lang aikido>native function strdup(s) println (strdup ("Hello World!"))</lang>

The second way is to use a raw native function. These functions must adhere to a defined set of rules and can be called directly from the Aikido interpreter. In the case of strdup we need to play a nasty trick because it returns a pointer that we need to print as a string.

<lang aikido>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</lang>

AutoHotkey

from the documentation for dllcall: <lang AutoHotkey>; 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%.</lang>

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> 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%

</lang>

C++

While calling C functions from C++ is generally almost trivial, strdup illustrates some fine point in communicating with C libraries. However, to illustrate how to generally use C functions, a C function strdup1 is used, which is assumed to have the same interface and behaviour as strdup, but cannot be found in a standard header.

In addition, this code demonstrates a call to a FORTRAN function defined as <lang cpp>FUNCTION MULTIPLY(X, Y) DOUBLE PRECISION MULTIPLY, X, Y</lang> Note that the calling convention of FORTRAN depends on the system and the used FORTRAN compiler, and sometimes even on the command line options used for the compiler; here, GNU Fortran with no options is assumed. <lang cpp>#include <cstdlib> // for C memory management

1. include <string> // for C++ strings
2. 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);

}</lang>

Clojure

Library: clojure-jna

Since Clojure is hosted on the JVM, you can follow the same approach as the Java solution and invoke your Java class from Clojure: <lang clojure>(JNIDemo/callStrdup "Hello World!")</lang>

Alternatively, to avoid having to create a library in native code you could use JNA and the clojure-jna library for convenience. Here's how you can invoke strcmp from the libc shared library: <lang clojure>(require '[net.n01se.clojure-jna :as jna])

(jna/invoke Integer c/strcmp "apple" "banana" )  ; returns -1

(jna/invoke Integer c/strcmp "banana" "apple" )  ; returns 1

(jna/invoke Integer c/strcmp "banana" "banana" )  ; returns 0</lang>

CMake

This example defines CMake command div() to call C function div(). Only works in a project, not in a cmake -P script. Uses more than 20 lines of CMake and 50 lines of C.

CMakeLists.txt <lang cmake>cmake_minimum_required(VERSION 2.6) project("outer project" C)

1. 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()

1. Load cmDIV.

load_command(DIV ${CMAKE_BINARY_DIR}/div) if(NOT CMAKE_LOADED_COMMAND_DIV)

 message(FATAL_ERROR "Failed to load cmDIV")

endif()

1. Try div() command.

div(quot rem 2012 500) message("

 2012 / 500 = ${quot}
 2012 % 500 = ${rem}

")</lang>

div/CMakeLists.txt <lang cmake>cmake_minimum_required(VERSION 2.6) project(div C)

1. Find cmCPluginAPI.h

include_directories(${CMAKE_ROOT}/include)

1. Compile cmDIV from div-command.c

add_library(cmDIV MODULE div-command.c)</lang>

div/div-command.c <lang c>#include <cmCPluginAPI.h>

1. include <stdio.h>
2. 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; }</lang>

Common Lisp

Library: CFFI

<lang lisp>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</lang>

D

<lang d>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);

}</lang>

Output:

str1: Hello World!
str2: Hello World!

Delphi

Importing the function from a shared library

If you have the function to be called available as a shared library you just do an import of that function using the means as shown for calling a function from a shared library.

Object Files

There is limited support for linking a function using an object file. For this to work the object file has to be in Borland Linker compatible format. Trying to use a GCC-created object file doesn't work.

The file first has to be bound to your unit:

<lang delphi> {$O myhello.obj} </lang>

The next step is to do an external declaration for the function: <lang delphi> procedure Hello(S: PChar); stdcall; external; </lang>

Afterwards usage of the function is just as with any other function.

Factor

If you declare a parameter as c-string, Factor automatically converts NULL-terminated C strings to Factor strings and back. In this case we additionally have to free the returned string, so we have to do the conversion explicitly; else the reference to the pointer would be dropped behind the scenes.

libc is already loaded, it is used by Factor elsewhere. <lang factor>FUNCTION: char* strdup ( c-string s ) ;

my-strdup ( str -- str' )

   strdup [ utf8 alien>string ] [ (free) ] bi ;</lang>

( scratchpad ) "abc" my-strdup .
"abc"

FBSL

Alongside its interpretative BASIC-style layer, FBSL also hosts built-in Intel-style Dynamic Assembler JIT and ANSI-C Dynamic C JIT compiler layers. BASIC, DynAsm and DynC procedures can be mixed freely to best suit the host script's intended purposes. The procedures follow their own respective syntaxes but are called in the host script in exactly the same way:

#APPTYPE CONSOLE

PRINT BasFoo(1), " ", AsmFoo(2), " ", CeeFoo(3)

PAUSE

FUNCTION BasFoo(parm AS INTEGER) AS INTEGER

RETURN parm

END FUNCTION

DYNASM AsmFoo(parm AS INTEGER) AS INTEGER

ENTER 0, 0

MOV EAX, parm

LEAVE

RET

END DYNASM

DYNC CeeFoo(parm AS INTEGER) AS INTEGER

int main(int parm)

{

return parm;

}

END DYNC

Output:

1 2 3
Press any key to continue...

FBSL has been specifically designed to cooperate with dynamic-link libraries. Such Windows system libraries as Kernel32.dll, User32.dll, and Gdi32.dll (also msvcrt.dll for the Dynamic C layer) are mapped into the process memory at app start so that over 2,300 functions of their API are always ready for use in an FBSL script as if they were native to FBSL's own namespace.

Other DLL's can be mapped into the script namespace either on a per-function basis (BASIC only) or entirely in one swoop, e.g.:

' all BASIC names are case-insensitive
#DLLDECLARE Gdiplus(GdiplusStartup AS SpawnIt, GdipLoadImageFromFile, GdiplusShutdown AS KillIt)
#DLLIMPORTS OpenGL32

; all DynAsm names are case-insensitive
INCLUDELIB OpenGL32

// DLL names in DynC are case-insensitive
#pragma comment(lib, "OpenGL32")

whereby you may start to use the three GDI+ function names (either directly or through arbitrary aliases as shown above), as well as the entire namespace of OpenGL functions, in your script.

Alternatively, a dynamic call to a DLL function can be made in FBSL's BASIC regardless of whether the DLL is already loaded or not:

APICALL(szFooName, szDllName[, parameters...])

Lastly, there are at least two methods in FBSL's BASIC to call in-memory machine code routines given their entry points:

CALLABSOLUTE(varByteBuffer[, parm1[, parm2[, parm3[, parm4]]]]) ' varByteBuffer stores machine code bytes
FUNCALL(varEntryPoint[, parameters...]) ' varEntryPoint stores function call address

All FBSL function calls support Integer, Quad, Single, Double and String parameters and returns. FBSL supports natively ASCIIZ strings only. Unicode strings in FBSL's BASIC require explicit ANSITOWIDE()/WIDETOANSI() transforms.

FBSL features a built-in stack balancing mechanism which eliminates stack corruption regardless of whether the API calls are using STDCALL or CDECL calling conventions. Please note that FBSL's BASIC and DynAsm do not make use of forward function declarations or header files.

Forth

Works with: GNU Forth version 0.7.0

Every version of GNU Forth has experimented with a different means to do C foreign function calls. The current implementation resolves various incompatibilities which had plagued earlier mechanisms by parsing C header files and using the host's native toolchain (i.e. gcc and ld) to generate thunks.

<lang forth>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()</lang>

Fortran

Works on Linux with GNU gcc and gfortran 5.1.1

A simple "C" function add_n in shared_lib.c <lang c> double add_n(double* a, double* b) { return *a + *b; }

</lang>

create shared_lib.so

gcc -shared -fPIC shared_lib.c -o shared_lib.so

Using C binding load shared_lib.so and call function add_n dynamically. <lang fortran> !----------------------------------------------------------------------- !module dll_module !----------------------------------------------------------------------- module dll_module

  use iso_c_binding
  implicit none
  private ! all by default
  public :: os_type, dll_type, load_dll, free_dll, init_os_type, init_dll
  ! general constants:
  ! the number of bits in an address (32-bit or 64-bit).
  integer, parameter :: bits_in_addr = c_intptr_t*8
  ! global error-level variables:
  integer, parameter :: errid_none = 0
  integer, parameter :: errid_info = 1
  integer, parameter :: errid_warn = 2
  integer, parameter :: errid_severe = 3
  integer, parameter :: errid_fatal = 4

  integer :: os_id

  type os_type
     character(10) :: endian
     character(len=:), allocatable :: newline
     character(len=:), allocatable :: os_desc
     character(1) :: pathsep
     character(1) :: swchar
     character(11) :: unfform
  end type os_type

  type dll_type
     integer(c_intptr_t) :: fileaddr
     type(c_ptr) :: fileaddrx
     type(c_funptr) :: procaddr
     character(1024) :: filename
     character(1024) :: procname
  end type dll_type

  ! interface to linux API
  interface
     function dlopen(filename,mode) bind(c,name="dlopen")
        ! void *dlopen(const char *filename, int mode);
        use iso_c_binding
        implicit none
        type(c_ptr) :: dlopen
        character(c_char), intent(in) :: filename(*)
        integer(c_int), value :: mode
     end function

     function dlsym(handle,name) bind(c,name="dlsym")
        ! void *dlsym(void *handle, const char *name);
        use iso_c_binding
        implicit none
        type(c_funptr) :: dlsym
        type(c_ptr), value :: handle
        character(c_char), intent(in) :: name(*)
     end function

     function dlclose(handle) bind(c,name="dlclose")
        ! int dlclose(void *handle);
        use iso_c_binding
        implicit none
        integer(c_int) :: dlclose
        type(c_ptr), value :: handle
     end function
  end interface

contains

  !-----------------------------------------------------------------------
  !Subroutine init_dll
  !-----------------------------------------------------------------------
  subroutine init_dll(dll)
     implicit none
     type(dll_type), intent(inout) :: dll
     dll % fileaddr = 0
     dll % fileaddrx = c_null_ptr
     dll % procaddr = c_null_funptr
     dll % filename = " "
     dll % procname = " "
  end subroutine init_dll

  !-----------------------------------------------------------------------
  !Subroutine init_os_type
  !-----------------------------------------------------------------------
  subroutine init_os_type(os_id,os)
     implicit none
     integer, intent(in) :: os_id
     type(os_type), intent(inout) :: os

     select case (os_id)
      case (1) ! Linux

        os % endian = 'big_endian'
        os % newline = achar(10)
        os % os_desc = 'Linux'
        os % pathsep = '/'
        os % swchar = '-'
        os % unfform = 'unformatted'

      case (2) ! MacOS

        os % endian = 'big_endian'
        os % newline = achar(10)
        os % os_desc = 'MacOS'
        os % pathsep = '/'
        os % swchar = '-'
        os % unfform = 'unformatted'

      case default

     end select

  end subroutine init_os_type

  !-----------------------------------------------------------------------
  !Subroutine load_dll
  !-----------------------------------------------------------------------
  subroutine load_dll (os, dll, errstat, errmsg )
     ! this subroutine is used to dynamically load a dll.

     type (os_type), intent(in) :: os
     type (dll_type), intent(inout) :: dll
     integer, intent( out) :: errstat
     character(*), intent( out) :: errmsg

     integer(c_int), parameter :: rtld_lazy=1
     integer(c_int), parameter :: rtld_now=2
     integer(c_int), parameter :: rtld_global=256
     integer(c_int), parameter :: rtld_local=0

     errstat = errid_none
     errmsg = 

     select case (os%os_desc)
      case ("Linux","MacOS")
        ! load the dll and get the file address:
        dll%fileaddrx = dlopen( trim(dll%filename)//c_null_char, rtld_lazy )
        if( .not. c_associated(dll%fileaddrx) ) then
           errstat = errid_fatal
           write(errmsg,'(i2)') bits_in_addr
           errmsg = 'the dynamic library '//trim(dll%filename)//' could not be loaded. check that the file '// &
           'exists in the specified location and that it is compiled for '//trim(errmsg)//'-bit systems.'
           return
        end if

        ! get the procedure address:
        dll%procaddr = dlsym( dll%fileaddrx, trim(dll%procname)//c_null_char )
        if(.not. c_associated(dll%procaddr)) then
           errstat = errid_fatal
           errmsg = 'the procedure '//trim(dll%procname)//' in file '//trim(dll%filename)//' could not be loaded.'
           return
        end if

      case ("Windows")
        errstat = errid_fatal
        errmsg = ' load_dll not implemented for '//trim(os%os_desc)

      case default
        errstat = errid_fatal
        errmsg = ' load_dll not implemented for '//trim(os%os_desc)
     end select
     return
  end subroutine load_dll

  !-----------------------------------------------------------------------
  !Subroutine free_dll
  !-----------------------------------------------------------------------
  subroutine free_dll (os, dll, errstat, errmsg )

     ! this subroutine is used to free a dynamically loaded dll
     type (os_type), intent(in) :: os
     type (dll_type), intent(inout) :: dll
     integer, intent( out) :: errstat
     character(*), intent( out) :: errmsg

     integer(c_int) :: success

     errstat = errid_none
     errmsg = 

     select case (os%os_desc)
      case ("Linux","MacOS")

        ! close the library:
        success = dlclose( dll%fileaddrx )
        if ( success /= 0 ) then
           errstat = errid_fatal
           errmsg = 'the dynamic library could not be freed.'
           return
        else
           errstat = errid_none
           errmsg = 
        end if

      case ("Windows")

        errstat = errid_fatal
        errmsg = ' free_dll not implemented for '//trim(os%os_desc)

      case default
        errstat = errid_fatal
        errmsg = ' free_dll not implemented for '//trim(os%os_desc)
     end select

     return
  end subroutine free_dll

end module dll_module

!----------------------------------------------------------------------- !Main program !----------------------------------------------------------------------- program test_load_dll

  use, intrinsic :: iso_c_binding
  use dll_module
  implicit none

  ! interface to our shared lib
  abstract interface
     function add_n(a,b)
        use, intrinsic :: iso_c_binding
        implicit none
        real(c_double), intent(in) :: a,b
        real(c_double) :: add_n
     end function add_n
  end interface

  type(os_type) :: os
  type(dll_type) :: dll
  integer :: errstat
  character(1024) :: errmsg
  type(c_funptr) :: cfun
  procedure(add_n), pointer :: fproc

  call init_os_type(1,os)
  call init_dll(dll)

  dll%filename="/full_path_to/shared_lib.so"
  ! name of the procedure in shared_lib
  dll%procname="add_n"

  write(*,*) "address: ", dll%procaddr

  call load_dll(os, dll, errstat, errmsg )
  write(*,*)"load_dll: errstat=", errstat
  write(*,*) "address: ", dll%procaddr

  call c_f_procpointer(dll%procaddr,fproc)

  write(*,*) "add_n(2,5)=",fproc(2.d0,5.d0)

  call free_dll (os, dll, errstat, errmsg )
  write(*,*)"free_dll: errstat=", errstat

end program test_load_dll

</lang>

gfortran-5 test_load_dll.f90 -ldl -o test_load_dll.x

Output:

 address:                     0
 load_dll: errstat=           0
 address:        47066464478944
 add_n(2,5)=   7.0000000000000000     
 free_dll: errstat=           0

Finally, using C language interoperability you can call every foreign-language function in fortran if you are able to write some additional wrapper function in C language.

Go

Using cgo, part of the standard Go command set. <lang go>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)

}</lang> Output:

hello C

Haskell

<lang Haskell>{-# 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</lang>

Icon and Unicon

(This probably also works for Icon, but only tested on Unicon, and on Linux.)

The first step is to create a shared library, to wrap the target C functions and do type conversions on the input and returned values. The arguments to the wrapper functions form a list, and this list must be unpacked to retrieve the arguments to send to the target function. To get at strdup and strcat we would have:

<lang C>

1. include <string.h>
2. 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);

} </lang>

Then the Unicon program must 'access' the function in the shared library: the important step is 'loadfunc' which accesses the named function in the shared library. After that, the C function can be called from within a program:

<lang Unicon> $define LIB "libstrdup-wrapper.so"

1. 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 </lang>

Output:

$ ./str-test
abc
abcdef

J

Here is a windows specific implementation (for relatively recent versions of windows):

<lang J>require 'dll' strdup=: 'msvcrt.dll _strdup >x *' cd < free=: 'msvcrt.dll free n x' cd < getstr=: free ] memr@,&0 _1</lang>

With these definitions: <lang J> getstr@strdup 'Hello World!' Hello World!</lang>

Portability is possible, but often irrelevant for a task of this sort. To make this work with a different OS, you would need to use the appropriate file name for libc for the os in question. For example, on linux, replace msvcrt.dll with /lib/libc.so.6 (or whichever version of libc you are using).

See also: J's documentation

Java

Java uses JNI to call other languages directly. Because it is a managed language, a "shim" layer needs to be created when dealing with things outside of the managed environment.

First, we start with the java source code:

JNIDemo.java <lang java>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);

}</lang>

Two things to note: First, the "native" stub which will be linked with a native library, and second, the call to System.loadLibrary to actually do the linking at runtime. The class must then be compiled without the native library.

Next, a C-style ".h" file needs to be created from the class. This can be done by running javah on our compiled class:

javah -jni JNIDemo

The generated file, JNIDemo.h: <lang c>/* DO NOT EDIT THIS FILE - it is machine generated */

1. include <jni.h>

/* Header for class JNIDemo */

1. ifndef _Included_JNIDemo
2. define _Included_JNIDemo
3. ifdef __cplusplus

extern "C" {

1. endif

/*

* Class:     JNIDemo
* Method:    callStrdup
* Signature: (Ljava/lang/String;)Ljava/lang/String;
*/

JNIEXPORT jstring JNICALL Java_JNIDemo_callStrdup

 (JNIEnv *, jclass, jstring);

1. ifdef __cplusplus

}

1. endif
2. endif</lang>

Next, the C code which utilizes JNI to bridge between the managed and unmanaged environments. It should include the "h" file, and implement the exported function declared in that file. The specifics of writing JNI code are beyond the scope of this task.

JNIDemo.c <lang c>#include "string.h"

1. 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;

} </lang>

In a Windows environment, a dll by the same name should be created ("JNIDemo.dll"). In a Linux environment, a shared object marked executable and with a name preceded by "lib" should be created (in this case, "libJNIDemo.so"). Your compiler will need to know the location of "jni.h", which is in the "include" directory of the JDK. Linux may also need includes that are in the "include/linux" directory. Linux example using gcc:

gcc -shared -fPIC -I/usr/jdk/include -I/usr/jdk/include/linux -o libJNIDemo.so JNIDemo.c

And finally, to run the program, the library must be in the runtime's library path. If the directory in which the library resides is not in this path, it can be explicitly specified using the "-D" option (e.g. "-Djava.library.path=." would specify the current directory as the library path).

java -Djava.library.path=. JNIDemo
Hello World!

Julia

Julia has a built-in keyword ccall to call external C-like functions. For example: <lang julia>julia> p = ccall(:strdup, Ptr{Uint8}, (Ptr{Uint8},), "Hello world") Ptr{Uint8} @0x000000011731bde0

julia> bytestring(p) # convert pointer back to a native Julia string "Hello world"

julia> ccall(:free, Void, (Ptr{Uint8},), p)</lang>

LabVIEW

Use Connectivity >> Libraries & Executables >> Call Library Function Node to call an external .dll file. This example uses the WinAPI's MessageBoxA function.
This image is a VI Snippet, an executable image of LabVIEW code. The LabVIEW version is shown on the top-right hand corner. You can download it, then drag-and-drop it onto the LabVIEW block diagram from a file browser, and it will appear as runnable, editable code.

Lisaac

Use backtick notation (`...`) for referencing foreign language (C) features. <lang Lisaac>Section Header

+ name := TEST_C_INTERFACE;

// this will be inserted in front of the program - external := `#include <string.h>`;

Section Public

- main <- (

 + s : STRING_CONSTANT;
 + p : NATIVE_ARRAY[CHARACTER];

 s := "Hello World!";
 p := s.to_external;
 // this will be inserted in-place
 // use `expr`:type to tell Lisaac what's the type of the external expression
 p := `strdup(@p)` : NATIVE_ARRAY[CHARACTER];
 s.print;
 '='.print;
 p.println;
 // this will also be inserted in-place, expression type disregarded
 `free(@p)`;

);</lang>

Lua

Using the FFI library available in LuaJIT:

<lang lua>local ffi = require("ffi") ffi.cdef[[ char * strndup(const char * s, size_t n); int strlen(const char *s); ]]

local s1 = "Hello, world!" print("Original: " .. s1) local s_s1 = ffi.C.strlen(s1) print("strlen: " .. s_s1)

local s2 = ffi.string(ffi.C.strndup(s1, s_s1), s_s1) print("Copy: " .. s2) print("strlen: " .. ffi.C.strlen(s2)) </lang>

Luck

Luck supports interfacing with most C libraries out of the box:

<lang luck>import "stdio.h";; import "string.h";;

let s1:string = "Hello World!";; let s2:char* = strdup(cstring(s1));; puts(s2);; free(s2 as void*)</lang>

Maple

We can call strdup, as requested, in the following way <lang Maple>> strdup := define_external( strdup, s::string, RETURN::string, LIB = "/lib/libc.so.6" ): > strdup( "foo" );

                                "foo"

</lang> However, this doesn't make a lot of sense in Maple, since there can be only one copy of any Maple string in memory. Moreover, I don't see any easy way to free the memory allocated by strdup. A more sensible example for Maple follows. (It might be sensible if you wanted to compare your system library version of sin with the one built-in to Maple, for instance.) <lang Maple>> csin := define_external( sin, s::float[8], RETURN::float[8], LIB = "libm.so" ); csin := proc(s::numeric) option call_external, define_external(sin, s::float[8], RETURN::float[8], LIB = "libm.so");

   call_external(
   Array(1..8, [...], datatype = integer[4], readonly), false,
   args)

end proc

> csin( evalf( Pi / 2 ) );

                                  1.</lang>

Mathematica

This works on windows and on linux/mac (through Mono) <lang Mathematica>Needs["NETLink`"]; externalstrdup = DefineDLLFunction["_strdup", "msvcrt.dll", "string", {"string"}]; Print["Duplicate: ", externalstrdup["Hello world!"]]</lang> output

Duplicate: Hello world!

Maxima

<lang maxima>/* Maxima is written in Lisp and can call Lisp functions. Use load("funcs.lisp"), or inside Maxima: */

to_lisp(); > (defun $f (a b) (+ a b)) > (to-maxima)

f(5, 6); 11</lang>

Mercury

Mercury is designed to interact sensibly with foreign code, even while keeping itself as pure and as safe as is possible in such circumstances. Here is an example of calling C's strdup() function from within Mercury:

<lang mercury>:- module test_ffi.

- interface.

- import_module io.

- pred main(io::di, io::uo) is det.

- implementation.

% The actual FFI code begins here.

- pragma foreign_decl("C", "#include <string.h>").

- func strdup(string::in) = (string::out) is det.

- pragma foreign_proc("C", strdup(S::in) = (SD::out),

                      [will_not_call_mercury, not_thread_safe, promise_pure],
                      "SD = strdup(S);").

% The actual FFI code ends here.

main(!IO) :-

 io.write_string(strdup("Hello, worlds!\n"), !IO).

- end_module test_ffi.</lang>

Only the lines wrapped in comments matter for this. The rest is an application skeleton so this can be compiled and tested.

The first pragma, foreign_decl, inserts C code into the output of the compiler. Here the C function's type is declared. Other things that can be put in this pragma include globally-accessed macros, function declarations, variable declarations, etc.

After this the Mercury strdup/1 function itself is declared. For purposes of exposition it has been declared fully with types and modes. The modes, however, are redundant since by default functions in Mercury have all input parameters and an output return value. Also, the determinism is declared which is again redundant. By default Mercury functions are deterministic. That line could easily have been written thusly instead:

<lang mercury>:- func strdup(string) = string.</lang>

The next block of code is the foreign_proc pragma declaration. In this declaration the language ("C") is declared, the footprint of the function is again provided, this time with variable names and modes but without the determinism, a set of properties is declared and the actual C code to be executed is provided. This last piece is trivial, but the properties themselves are worth looking more closely at.

Flagging appropriate properties to foreign language code is vital to the efficient and safe execution of foreign functions. Here we are saying that the foreign code will not be calling back in to the Mercury runtime (will_not_call_mercury), should not be called in parallel (not_thread_safe) and that the C function is "pure" and has no (visible) side effects (promise_pure). Each of these has implications for efficiency and safety; the Mercury compiler will generate the best code possible within the properties' provided constraints.

Of note is that no separate C source file needs to be provided. The compiler takes care of putting in all the required boilerplate code necessary to conform to the specifications provided. The resulting code can be treated as much a part of the program as any native Mercury code would be: types, modes, determinism, purity, etc. all managed similarly.

Modula-2

The first file (Vga.c) creates the function prototypes. <lang c>#include <vga.h>

int Initialize (void) {

  if ( vga_init () == 0 )
    return 1;
  else
    return 0;

}

void SetMode (int newmode) {

  vga_setmode (newmode);

}

int GetMode (void) {

  return vga_getcurrentmode ();

}

int MaxWidth (void) {

  return vga_getxdim ();

}

int MaxHeight (void) {

  return vga_getydim ();

}

void Clear (void) {

  vga_clear ();

} void SetColour (int colour) {

  vga_setcolor (colour);

}

void SetEGAcolour (int colour) {

  vga_setegacolor (colour);

}

void SetRGB (int red, int green, int blue) {

  vga_setrgbcolor (red, green, blue);

}

void DrawLine (int x0, int y0, int dx, int dy) {

  vga_drawline (x0, y0, x0 + dx, y0 + dy);

}

void Plot (int x, int y) {

  vga_drawpixel (x, y);

}

int ThisColour (int x, int y) {

  return vga_getpixel (x, y);

}

void GetKey (char *ch) {

  *ch = vga_getkey ();

}</lang> The next file is the definition module, but in this context it is called a FOREIGN MODULE. <lang modula2>FOREIGN MODULE Vga;

TYPE EGAcolour = (black, blue, green, cyan, red, pink, brown, white,

                      GREY, BLUE, GREEN, CYAN, RED, MAGENTA, YELLOW, WHITE);

PROCEDURE Initialize () : BOOLEAN;

PROCEDURE MaxWidth () : CARDINAL;

PROCEDURE MaxHeight () : CARDINAL;

PROCEDURE Clear;

PROCEDURE SetColour (colour : CARDINAL);

PROCEDURE SetEGAcolour (colour : CARDINAL);

PROCEDURE SetRGB (red, green, blue : CARDINAL);

PROCEDURE DrawLine (x0, y0, dx, dy : CARDINAL);

PROCEDURE Plot (x, y : CARDINAL);

PROCEDURE ThisColour (x, y : CARDINAL) : CARDINAL;

PROCEDURE SetMode (newmode : CARDINAL);

PROCEDURE GetMode () : CARDINAL;

PROCEDURE GetKey (VAR ch : CHAR);

END Vga.</lang> The third file is an example program. <lang modula2>MODULE svg01;

FROM InOut IMPORT Read, Write, WriteBf, WriteString;

IMPORT Vga;

VAR OldMode, x, y  : CARDINAL;

     ch                        : CHAR;

BEGIN

  IF  Vga.Initialize () = FALSE  THEN
     WriteString ('Could not start SVGAlib libraries. Aborting...');
     WriteBf;
     HALT
  END;
  OldMode := Vga.GetMode ();
  Vga.SetMode (4);
  Vga.SetColour (14);
  Vga.Clear ();
  Vga.SetColour (10);
  FOR y := 125 TO 175 DO
     FOR x := 100 TO 500 DO
        Vga.Plot (x, y)
     END
  END;
  LOOP
     Read (ch);
     IF  ch = 'X'  THEN  EXIT  END
  END;
  Vga.SetMode (OldMode);
  Write (ch);
  WriteBf;

END svg01.</lang>

Modula-3

Modula-3 provides many predefined interfaces to C files. Here we use Cstring which uses C string functions. Note we have to convert strings of type TEXT into C strings (NULL terminated character arrays). Also note the code requires the UNSAFE keyword because it interfaces with C (which is unsafe). <lang modula3>UNSAFE MODULE Foreign EXPORTS Main;

IMPORT IO, Ctypes, Cstring, M3toC;

VAR string1, string2: Ctypes.const_char_star;

BEGIN

 string1 := M3toC.CopyTtoS("Foobar");
 string2 := M3toC.CopyTtoS("Foobar2");
 IF Cstring.strcmp(string1, string2) = 0 THEN
   IO.Put("string1 = string2\n");
 ELSE
   IO.Put("string1 # string2\n");
 END;
 M3toC.FreeCopiedS(string1);
 M3toC.FreeCopiedS(string2);

END Foreign.</lang> Output:

string1 # string2

NewLISP

newLISP has two FFI APIs. The simple API needs no type specifiers but is limited to integers and pointers. The extended API can specify types for return values and parameters and can also be used for floats and structs. <lang NewLISP>; simple FFI interface on Mac OSX (import "libc.dylib" "strdup") (println (get-string (strdup "hello world")))

or extended FFI interface on Mac OSX

(import "libc.dylib" "strdup" "char*" "char*") (println (strdup "hello world")) </lang>

Nim

Since Nim compiles to C by default, this task is easily done:

<lang nim>proc strcmp(a, b: cstring): cint {.importc: "strcmp", nodecl.} echo strcmp("abc", "def") echo strcmp("hello", "hello")

proc printf(formatstr: cstring) {.header: "<stdio.h>", varargs.}

var x = "foo" printf("Hello %d %s!\n", 12, x)</lang>

OCaml

Outline of what is linked against

For the hypothetical C library that contains functions described by a header file with this in: <lang ocaml>void myfunc_a(); float myfunc_b(int, float); char *myfunc_c(int *);</lang>

The header file is named "mylib.h", and linked against the library with -lmylib and compiled with -I/usr/include/mylib.

Required files

Here are provided all the files, including a Makefile.

file "mylib.ml":

<lang ocaml>external myfunc_a: unit -> unit = "caml_myfunc_a" external myfunc_b: int -> float -> float = "caml_myfunc_b" external myfunc_c: int array -> string = "caml_myfunc_c"</lang>

file "wrap_mylib.c":

<lang c>#include <caml/mlvalues.h>

1. include <caml/alloc.h>
2. include <mylib.h>

CAMLprim value caml_myfunc_a(value unit) {

   myfunc_a();
   return Val_unit;

}

CAMLprim value caml_myfunc_b(value a; value b) {

   float c = myfunc_b(Int_val(a), Double_val(b));
   return caml_copy_double(c);

}

CAMLprim value caml_myfunc_c(value ml_array) {

   int i, len;
   int *arr;
   char *s;
   len = Wosize_val(ml_array);
   arr = malloc(len * sizeof(int));
   for (i=0; i < len; i++) {
       arr[i] = Int_val(Field(ml_array, i));
   }
   s = myfunc_c(arr);
   free(arr);
   return caml_copy_string(s);

}</lang>

the Makefile:

<lang makefile>wrap_mylib.o: wrap_mylib.c

       ocamlc -c -ccopt -I/usr/include/mylib $<

dllmylib_stubs.so: wrap_mylib.o

       ocamlmklib -o mylib_stubs $< -lmylib

mylib.mli: mylib.ml

       ocamlc -i $< > $@

mylib.cmi: mylib.mli

       ocamlc -c $<

mylib.cmo: mylib.ml mylib.cmi

       ocamlc -c $<

mylib.cma: mylib.cmo dllmylib_stubs.so

       ocamlc -a -o $@ $< -dllib -lmylib_stubs -cclib -lmylib

mylib.cmx: mylib.ml mylib.cmi

       ocamlopt -c $<

mylib.cmxa: mylib.cmx dllmylib_stubs.so

       ocamlopt -a -o $@ $< -cclib -lmylib_stubs -cclib -lmylib

clean:

       rm -f *.[oa] *.so *.cm[ixoa] *.cmxa</lang>

the file mylib.cma is used for the interpreted and bytecode modes, and mylib.cmxa is for the native mode.

Oz

First we need to create a so-called "native functor" that converts the arguments and describes the C functions: <lang cpp>#include "mozart.h"

1. include <string.h>

OZ_BI_define(c_strdup,1,1) {

 OZ_declareVirtualString(0, s1);
 char* s2 = strdup(s1);
 OZ_Term s3 = OZ_string(s2);
 free( s2 );
 OZ_RETURN( s3 );

} OZ_BI_end

OZ_C_proc_interface * oz_init_module(void) {

 static OZ_C_proc_interface table[] = {
   {"strdup",1,1,c_strdup},
   {0,0,0,0}
 };
 return table;

}</lang>

Save this file as "strdup.cc". To automate compiling and linking, we need a makefile for ozmake, the Oz build tool. Save this file as "makefile.oz": <lang oz>makefile(

  lib : [

'strdup.o' 'strdup.so' ]

  rules:o('strdup.so':ld('strdup.o'))
  )</lang>

Call ozmake in the same directory.

Now we can write some code that uses the wrapped C function (make sure Emacs' working directory is set to the same directory):

<lang oz>declare

 [Strdup] = {Module.link ['strdup.so{native}']}

in

 {System.showInfo {Strdup.strdup "hello"}}</lang>

PARI/GP

Of course it is trivial to include C functions in PARI, and not uncommon. In GP the system and install commands allow foreign-language functions to be called.

Pascal

See Delphi

Perl

Perl code calls a C function c_dup() passing a string 'Hello' as an argument, which gets transparently converted to a C string, the c_dup() function makes a copy of that string using strdup() function, stores pointer to the copy in the copy variable and returns it. The returned char pointer gets converted transparently to a Perl string value and gets returned to the calling Perl code which prints it. Then the Perl code calls a C function c_free() to free the allocated memory. Both of the C functions are defined inline in the Perl program and are automatically compiled (only once, unless they change) and linked at runtime. Here is the entire program: <lang perl>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();</lang>

Another example, instead of returning the copy to Perl code it prints it using C printf: <lang perl>use Inline C => q{

   void c_hello (char *text) {
       char *copy = strdup(text);
       printf("Hello, %s!\n", copy);
       free(copy);
   }

}; c_hello 'world';</lang>

Perl 6

<lang perl6>use NativeCall;

sub strdup(Str $s --> OpaquePointer) is native {*} sub puts(OpaquePointer $p --> int) is native {*} sub free(OpaquePointer $p --> int) is native {*}

my $p = strdup("Success!"); say 'puts returns ', puts($p); say 'free returns ', free($p);</lang>

Output:

Success!
puts returns 9
free returns 0

PicoLisp

The easiest is to inline the C code. Another possibility would be to write it into a separate shared object file (see "Call a function in a shared library").

There are differences between the 32-bit and 64-bit versions. While the 64-bit version can interface directly to C functions, requires the 32-bit function some glue code.

32-bit version

<lang PicoLisp>(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!"))</lang>

64-bit version

<lang PicoLisp>(load "@lib/native.l")

(gcc "str" NIL

  (duptest (Str) duptest 'S Str) )

1. include <stdlib.h>
2. 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!"))</lang>

Output in both cases:

Duplicate "Hello world!"

PL/I

<lang>declare strdup entry (character (30) varyingz) options (fastcall16);

put (strdup('hello world') );</lang>

Prolog

In SWI-Prolog we need to do two things. First we need to declare a mapping from a Prolog file to a C implementation:

<lang prolog>:- module(plffi, [strdup/2]).

- use_foreign_library(plffi).</lang>

This declares a module "plffi" that exports the predicate (not function!) "strdup/2". This predicate has two arguments: the first being the atom being strduped, the second being the duped atom. (You can think of these as an in parameter and an out parameter and be about 2/3 right.)

Then we need to write a C file that gives us the interface to the underlying C function (strdup in this case), mapping the predicate' call to a C function call:

<lang c>#include <string.h>

1. include <stdio.h>
2. include <SWI-Prolog.h>

static foreign_t pl_strdup(term_t string0, term_t string1) {

 char *input_string, *output_string;

 if (PL_get_atom_chars(string0, &input_string))
 {
   output_string = strdup(input_string);
   return PL_unify_atom_chars(string1, output_string);
 }
 PL_fail;

}

install_t install_plffi() {

 PL_register_foreign("strdup", 2, pl_strdup, 0);

}</lang>

This C code provides us with two things. The function install_plffi() is provided to register the name "strdup" and to map it to its C implementation pl_strdup(). Here we're saying that "strdup" has an arity of 2, is implemented by pl_strdup and has no special flags.

The function pl_strdup() is where the action is. First we extract the input string from the first parameter (the in parameter for a slightly inaccurate way of looking at it). If that succeeds, we call C's strdup() function for the output string. We then unify this with the second parameter (the out parameter for that same slightly inaccurate way of thinking).

We compile this very easily:

<lang sh>$ swipl-ld -o plffi -shared plffi.c</lang>

Then, from within the SWI-Prolog interactor:

<lang Prolog>?- [plffi]. % plffi compiled into plffi 0.04 sec, 1,477 clauses true.

?- strdup('Booger!', X). X = 'Booger!'.

?- strdup(booger, X). X = booger.

?- strdup(booger, booger). true.

?- X = booger, strdup(booger, X). X = booger.</lang>

PureBasic

Here we will use Fasm (flat assembler) to create an object file and then import the function strucase(t.s) As "_strucase@4". The object file is statically linked within the resulting executable. PureBasic supports {Windows, Linux, MacOS}.

<lang PureBasic>

Call_a_foreign_language_function.fasm -> Call_a_foreign_language_function.obj

the assembler code...

format COFF or

format COFF64 classic (DJGPP) variants of COFF file

format MS COFF or

format MS COFF64 Microsoft's variants of COFF file

format MS COFF

include "Win32A.Inc"

section ".text" executable readable code

proc strucase stdcall str:dword xor eax,eax mov ebx,[str] strucase_loop: mov al,byte[ebx] cmp al,0 jz strucase_is_null_byte cmp al,'a' jb strucase_skip cmp al,'z' ja strucase_skip and al,11011111b strucase_skip:

mov byte[ebx],al

xchg al,byte[ebx] inc ebx jmp strucase_loop strucase_is_null_byte: xor eax,eax mov eax,[str] ret endp

public strucase as "_strucase@4" </lang>

<lang PureBasic>

the PureBasic code...

Import "Call_a_foreign_language_function.obj" strucase(t.s) As "_strucase@4" EndImport

t.s="hElLo WoRld!!"

• r=StrUcase(t.s) ; PureBasic is case-insensitive

cw(peeks(*r))

Debug peeks(*r) </lang>

Sample Output

HELLO WORLD!!

Python

<lang python>import ctypes libc = ctypes.CDLL("/lib/libc.so.6") libc.strcmp("abc", "def") # -1 libc.strcmp("hello", "hello") # 0</lang>

Racket

<lang racket>

1. 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!") </lang>

REALbasic

<lang vb>

 Declare Function CreateFileW Lib "Kernel32" (FileName As WString, DesiredAccess As Integer, ShareMode As Integer, SecurityAttributes As Integer, _
       CreateDisposition As Integer, Flags As Integer, Template As Integer) As Integer
 Declare Function WriteFile Lib "Kernel32" (fHandle As Integer, writeData As Ptr, numOfBytes As Integer, ByRef numOfBytesWritten As Integer, _
       overlapped As Ptr) As Boolean
 Declare Function GetLastError Lib "Kernel32" () As Integer
 Declare Function CloseHandle Lib "kernel32" (hObject As Integer) As Boolean
 
 Const FILE_SHARE_READ = &h00000001
 Const FILE_SHARE_WRITE = &h00000002
 Const OPEN_EXISTING = 3
 
 Dim fHandle As Integer = CreateFileW("C:\foo.txt", 0,  FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
 If fHandle > 0 Then
   Dim mb As MemoryBlock = "Hello, World!"
   Dim bytesWritten As Integer
   If Not WriteFile(fHandle, mb, mb.Size, bytesWritten, Nil) Then
     MsgBox("Error Number: " + Str(GetLastError))
   End If
   Call CloseHandle(fHandle)
 Else
   MsgBox("Error Number: " + Str(GetLastError))
 End If

</lang>

REXX

The use of the   address   statement isn't normally required, but it's shown here as an illustrative example. <lang rexx>/*REXX program calls (invoke) a "foreign" (non-REXX) language routine/program.*/

cmd = "MODE" /*define the command that is to be used*/ opts= 'CON: CP /status' /*define the options to be used for cmd*/

address 'SYSTEM' cmd opts /*invoke a cmd via the SYSTEM interface*/

                                      /*stick a fork in it,  we're all done. */</lang>

output   when executing under a Microsoft Windows system in the USA:

Status for device CON:
----------------------
    Code page:      437

Ruby

There are three or four different approaches one can take.

By far still the most common today is writing a C binding that is compiled on installation and has to be recompiled when the underlying library changes.

Unfortunately I've never written one of these myself, maybe someone else can demonstrate it.

FFI

A recent effort to make it easier to write libraries, portable across platforms and interpreters, led to the creation of a libffi binding simply called ffi for completely dynamic calls.

<lang ruby> 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) </lang>

Fiddle

Ruby 1.9.2 added Fiddle to the standard library. DL finds foreign functions, and Fiddle uses libffi to call them. DL and Fiddle are poorly documented. They are not compatible with all platforms.

Works with: MRI version 1.9.2

<lang ruby>require 'dl' require 'fiddle'

1. Declare strdup().
2. * DL::Handle['strdup'] is the address of the function.
3. * The function takes a pointer and returns a pointer.

strdup = Fiddle::Function.new(DL::Handle['strdup'],

                             [DL::TYPE_VOIDP], DL::TYPE_VOIDP)

1. Call strdup().
2. * Fiddle converts our Ruby string to a C string.
3. * Fiddle returns a DL::CPtr.

duplicate = strdup.call("This is a string!")

1. DL::CPtr#to_s converts our C string to a Ruby string.

puts duplicate.to_s

1. We must call free(), because strdup() allocated memory.

DL.free duplicate</lang>

RubyInline

Using

Library: RubyGems

package RubyInline, which compiles the inlined code on demand during runtime.

<lang ruby>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)</lang>

outputs (note Ruby's implicit use of Bignum past 12!, while C is stuck with a long int):

[11, 39916800, 39916800]
[12, 479001600, 479001600]
[13, 6227020800, 1932053504]
[14, 87178291200, 1278945280]
9

Swift

Because Swift uses the Objective-C runtime it is trivial to call C/Objective-C functions directly in Swift. <lang Swift>import Foundation

let hello = "Hello, World!" let fromC = strdup(hello) let backToSwiftString = String.fromCString(fromC)</lang>

Tcl

Library: critcl

In this solution, we wrap up the ilogb function from C's math library with critcl so that it becomes one of Tcl's normal functions (assuming Tcl 8.5): <lang tcl>package require critcl critcl::code {

   #include <math.h>

} critcl::cproc tcl::mathfunc::ilogb {double value} int {

   return ilogb(value);

} package provide ilogb 1.0</lang> Note that we do not show strdup here because Tcl manages the memory for strings in complex ways and does not guarantee to preserve string pointers from one call into the C API to the next (e.g., if it has to apply an encoding transformation behind the scenes).