2016 Update

Task/Call-a-function-in-a-shared-library/COBOL/call-a-function-in-a-shared-library.cobol

@@ -0,0 +1,37 @@
+       identification division.
+       program-id. callsym.
+
+       data division.
+       working-storage section.
+       01 handle usage pointer.
+       01 addr   usage program-pointer.
+
+       procedure division.
+       call "dlopen" using
+           by reference null
+           by value 1
+           returning handle
+           on exception
+               display function exception-statement upon syserr
+               goback
+       end-call
+       if handle equal null then
+           display function module-id ": error getting dlopen handle"
+             upon syserr
+           goback
+       end-if
+
+       call "dlsym" using
+           by value handle
+           by content z"perror"
+           returning addr
+       end-call
+       if addr equal null then
+           display function module-id ": error getting perror symbol"
+              upon syserr
+       else
+           call addr returning omitted
+       end-if
+
+       goback.
+       end program callsym.

Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-4.f

@@ -0,0 +1,6 @@
+function ffun(x, y)
+    implicit none
+    !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE :: FFUN
+    double precision :: x, y, ffun
+    ffun = x + y * y
+end function

Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-5.f

@@ -0,0 +1,30 @@
+program dynload
+    use kernel32
+    use iso_c_binding
+    implicit none
+
+    abstract interface
+        function ffun_int(x, y)
+            !DEC$ ATTRIBUTES STDCALL, REFERENCE :: ffun_int
+            double precision :: ffun_int, x, y
+        end function
+    end interface
+
+    procedure(ffun_int), pointer :: ffun_ptr
+
+    integer(c_intptr_t) :: ptr
+    integer(handle) :: h
+    double precision :: x, y
+
+    h = LoadLibrary("dllfun.dll" // c_null_char)
+    if (h == 0) error stop "Error: LoadLibrary"
+
+    ptr = GetProcAddress(h, "ffun" // c_null_char)
+    if (ptr == 0) error stop "Error: GetProcAddress"
+
+    call c_f_procpointer(transfer(ptr, c_null_funptr), ffun_ptr)
+    read *, x, y
+    print *, ffun_ptr(x, y)
+
+    if (FreeLibrary(h) == 0) error stop "Error: FreeLibrary"
+end program

Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-6.f

@@ -0,0 +1,6 @@
+function ffun(x, y)
+    implicit none
+    !GCC$ ATTRIBUTES DLLEXPORT, STDCALL :: FFUN
+    double precision :: x, y, ffun
+    ffun = x + y * y
+end function

Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-7.f

@@ -0,0 +1,30 @@
+program dynload
+    use kernel32
+    use iso_c_binding
+    implicit none
+
+    abstract interface
+        function ffun_int(x, y)
+            !GCC$ ATTRIBUTES DLLEXPORT, STDCALL :: FFUN
+            double precision :: ffun_int, x, y
+        end function
+    end interface
+
+    procedure(ffun_int), pointer :: ffun_ptr
+
+    integer(c_intptr_t) :: ptr
+    integer(handle) :: h
+    double precision :: x, y
+
+    h = LoadLibrary("dllfun.dll" // c_null_char)
+    if (h == 0) error stop "Error: LoadLibrary"
+
+    ptr = GetProcAddress(h, "ffun_@8" // c_null_char)
+    if (ptr == 0) error stop "Error: GetProcAddress"
+
+    call c_f_procpointer(transfer(ptr, c_null_funptr), ffun_ptr)
+    read *, x, y
+    print *, ffun_ptr(x, y)
+
+    if (FreeLibrary(h) == 0) error stop "Error: FreeLibrary"
+end program

Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-8.f

@@ -0,0 +1,35 @@
+module kernel32
+    use iso_c_binding
+    implicit none
+    integer, parameter :: HANDLE = C_INTPTR_T
+    integer, parameter :: PVOID = C_INTPTR_T
+    integer, parameter :: BOOL = C_INT
+
+    interface
+        function LoadLibrary(lpFileName) bind(C, name="LoadLibraryA")
+            import C_CHAR, HANDLE
+            !GCC$ ATTRIBUTES STDCALL :: LoadLibrary
+            integer(HANDLE) :: LoadLibrary
+            character(C_CHAR) :: lpFileName
+        end function
+    end interface
+
+    interface
+        function FreeLibrary(hModule) bind(C, name="FreeLibrary")
+            import HANDLE, BOOL
+            !GCC$ ATTRIBUTES STDCALL :: FreeLibrary
+            integer(BOOL) :: FreeLibrary
+            integer(HANDLE), value :: hModule
+        end function
+    end interface
+
+    interface
+        function GetProcAddress(hModule, lpProcName) bind(C, name="GetProcAddress")
+            import C_CHAR, PVOID, HANDLE
+            !GCC$ ATTRIBUTES STDCALL :: GetProcAddress
+            integer(PVOID) :: GetProcAddress
+            integer(HANDLE), value :: hModule
+            character(C_CHAR) :: lpProcName
+        end function
+    end interface
+end module

Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-1.vba

@@ -0,0 +1,6 @@
+function ffun(x, y)
+    implicit none
+    !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE :: ffun
+    double precision :: x, y, ffun
+    ffun = x + y * y
+end function

Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-2.vba

@@ -0,0 +1,8 @@
+Option Explicit
+Declare Function ffun Lib "vbafun" (ByRef x As Double, ByRef y As Double) As Double
+Sub Test()
+    Dim x As Double, y As Double
+    x = 2#
+    y = 10#
+    Debug.Print ffun(x, y)
+End Sub