2016 Update

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