Data update

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

@@ -1,15 +0,0 @@
-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/COBOL/call-a-foreign-language-function.cobol

@@ -1,27 +0,0 @@
-       identification division.
-       program-id. foreign.
-
-       data division.
-       working-storage section.
-       01 hello.
-          05 value z"Hello, world".
-       01 duplicate    usage pointer.
-       01 buffer       pic x(16) based.
-       01 storage      pic x(16).
-
-       procedure division.
-       call "strdup" using hello returning duplicate
-           on exception
-               display "error calling strdup" upon syserr
-       end-call
-       if duplicate equal null then
-           display "strdup returned null" upon syserr
-       else
-           set address of buffer to duplicate
-           string buffer delimited by low-value into storage
-           display function trim(storage)
-           call "free" using by value duplicate
-               on exception
-                   display "error calling free" upon syserr
-       end-if
-       goback.

Task/Call-a-foreign-language-function/Ol/call-a-foreign-language-function-2.ol

@@ -1,9 +1,14 @@
 (import (otus ffi))
 
-(if (not (has? *features* 'Windows))
-   (print "The host platform is not a Windows!"))
+(define libc (or
+   (load-dynamic-library "libc.so") ; General Posix
+   (load-dynamic-library "libc.so.6") ; Linux
+   (load-dynamic-library "libc.so.7") ; Latest *BSD
+   (load-dynamic-library "libSystem.B.dylib") ; Mac
+   (load-dynamic-library "shlwapi.dll") )) ; Windows
 
-(define self (load-dynamic-library "shlwapi.dll"))
-(define strdup (self type-string "StrDupA" type-string))
+(define strdup (or
+   (libc type-string "strdup" type-string) ; All
+   (libc type-string "StrDupA" type-string) )) ; Win
 
 (print (strdup "Hello World!"))

Task/Call-a-foreign-language-function/Ol/call-a-foreign-language-function-3.ol

@@ -1,34 +1,26 @@
-; The sample usage of GTK3+ library
-(import (otus ffi)
-   (lib glib-2)
-   (lib gtk-3))
+(import (otus ffi))
 
-(define print_hello (vm:pin (cons
-   (list GtkWidget* gpointer)
-   (lambda (widget userdata)
-      (print "hello")
-      TRUE
-))))
+(define libc (or
+   (load-dynamic-library "libc.so") ; General Posix
+   (load-dynamic-library "libc.so.6") ; Linux
+   (load-dynamic-library "libc.so.7") ; Latest *BSD
+   (load-dynamic-library "libSystem.B.dylib") ; Mac
+   (load-dynamic-library "shlwapi.dll") )) ; Windows
 
-(define activate (vm:pin (cons
-   (list GtkApplication* gpointer)
-   (lambda (app userdata)
-      (define window (gtk_application_window_new app))
-      (print "window: " window)
-      (gtk_window_set_title window "Window")
-      (gtk_window_set_default_size window 200 200)
+(define lib2
+   (load-dynamic-library "kernel32.dll")) ; Windows
 
-      (define button_box (gtk_button_box_new GTK_ORIENTATION_HORIZONTAL))
-      (gtk_container_add window button_box)
+(define strdup
+   (let ((strdup (or
+            (libc type-vptr "strdup" type-string) ; All
+            (libc type-vptr "StrDupA" type-string))) ; Win
+         (free (or
+            (libc fft-void "free" type-vptr) ; All
+            (lib2 fft-void "LocalFree" type-vptr)))) ; Win
+      (lambda (str)
+         (let*((dupped (strdup str))
+               (result (vptr->string dupped)))
+            (free dupped)
+            result))))
 
-      (define button (gtk_button_new_with_label "Hello World"))
-      (g_signal_connect button "clicked"  (G_CALLBACK print_hello) NULL)
-      (gtk_container_add button_box button)
-
-      (gtk_widget_show_all window)
-))))
-
-(define app (gtk_application_new (c-string "org.gtk.example") G_APPLICATION_FLAGS_NONE))
-(g_signal_connect app (c-string "activate") (G_CALLBACK activate) NULL)
-
-(g_application_run app 0 #false)
+(print (strdup "Hello World!"))