Fixing the load interface

Makefile

@@ -16,14 +16,9 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.c: retropikzel/r7rs-pffi/r7rs-pffi-chibi.s
 
 retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.c
 	${CC} -o retropikzel/r7rs-pffi/r7rs-pffi-chibi.so \
+		retropikzel/r7rs-pffi/r7rs-pffi-chibi.c \
 		-fPIC \
-		-shared retropikzel/r7rs-pffi/r7rs-pffi-chibi.c \
+		-lffi
-		-lchibi-scheme \
-		-lffi \
-		-L${HOME}/.scman/chibi/lib \
-		-I${HOME}/.scman/chibi/include \
-		-L${HOME}/.scman/chibi-git/lib \
-		-I${HOME}/.scman/chibi-git/include
 
 test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
 	${CHIBI} test.scm

README.md

@@ -141,7 +141,7 @@ Usage recommended.
 ### Usage notes
 
 - Chibi
-    - Install libffi-dev
+    - Install libffi-dev libc-dev
     - Build with:
       - chibi-ffi retropikzel/r7rs-pffi/r7rs-pffi-chibi.stub
       - ${CC} -o retropikzel/r7rs-pffi/r7rs-pffi-chibi.so -fPIC -shared retropikzel/r7rs-pffi/r7rs-pffi-chibi.c -lchibi-scheme -lffi
@@ -189,11 +189,16 @@ Types are given as symbols, for example 'int8 or 'pointer.
 
 Some of these are procedures and some macros, it might also change implementation to implementation.
 
-##### **pffi-init**
+##### **pffi-init** [options]
 
 Always call this first, on most implementation it does nothing but some implementations might need
 initialisation run.
 
+Options:
+
+- debug?
+    - If set to true library will output debug logs
+
 ##### **pffi-size-of** type -> number
 
 Returns the size of the type.
@@ -202,11 +207,31 @@ Returns the size of the type.
 
 Returns the align of the type.
 
-##### **pffi-shared-object-auto-load**
+##### **pffi-shared-object-auto-load** headers shared-object-name [options] -> object
 
-TODO
+Load given shared object automatically searching many predefined paths.
 
-##### **pffi-shared-object-load** headers path
+Takes as argument a list of C headers, these are for the compiler ones. And an shared-object name,
+used by the dynamic FFI's. The name of the shared object should not contain suffix like .so or
+.dll. Nor should it contain any prefix like "lib".
+
+Additional options argument can be provided, which should be a list of lists starting with a
+keyword. The options are:
+
+- additional-versions
+    - Search for additional versions of shared object, given shared object "c" and additional
+    versions ".6" ".7" on linux the files "libc", "libc.6", "libc.7" are searched for.
+- additional-paths
+    - Give additional paths to search shared objects for
+
+Example:
+
+    (define libc-stdlib
+      (cond-expand
+        (windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase"))
+        (else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions (".6")))))))
+
+##### **pffi-shared-object-load** headers path [options]
 
 It is recommended to use the pffi-shared-object-auto-load instead of this
 directly.
@@ -219,6 +244,12 @@ Path is the full path of the shared object without any "lib" prefix or ".so/.dll
 
     "curl"
 
+
+Options:
+
+- versions
+    - List of different versions of library to try, for example (list ".0" ".1")
+
 ##### **pffi-pointer-null** -> pointer
 
 Returns a new NULL pointer.

manifest.scm

@@ -0,0 +1,9 @@
+;; What follows is a "manifest" equivalent to the command line you gave.
+;; You can store it in a file that you may then pass to any 'guix' command
+;; that accepts a '--manifest' (or '-m') option.
+
+(concatenate-manifests
+  (list (specifications->manifest
+          (list "chibi-scheme" "libffi"))
+        (package->development-manifest
+          (specification->package "chibi-scheme"))))

retropikzel/r7rs-pffi/chibi.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-size-of
   (lambda (type)
     (cond ((eq? type 'int8) (size-of-int8_t))

retropikzel/r7rs-pffi/chicken5.scm

@@ -1,8 +1,3 @@
-(define-syntax pffi-init
-  (er-macro-transformer
-    (lambda (expr rename compare)
-      '(import (chicken foreign)
-               (chicken memory)))))
 
 (define pffi-type->native-type
   (lambda (type)

retropikzel/r7rs-pffi/chicken6.scm

@@ -1,9 +1,3 @@
-(define-syntax pffi-init
-  (er-macro-transformer
-    (lambda (expr rename compare)
-      '(import (chicken foreign)
-               (chicken memory)))))
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) 'byte)

retropikzel/r7rs-pffi/cyclone.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) int)

retropikzel/r7rs-pffi/gambit.scm

@@ -1,7 +1,5 @@
 (c-declare "#include <stdint.h>")
 
-(define pffi-init (lambda () #t))
-
 ;(c-declare "int size_of_int8() { return sizeof(int8_t);}")
 ;(define size-of-int8 (c-lambda () int "__return(sizeof(int8_t));"))
 ;(define int8-size ((c-lambda () int "__return(sizeof(int8_t));")))

retropikzel/r7rs-pffi/gauche.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-size-of
   (lambda (type)
     (cond ((equal? type 'int8) 1))))

retropikzel/r7rs-pffi/gerbil.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-type->native-type
   (lambda (type)
     (error "Not defined")))

retropikzel/r7rs-pffi/guile.scm

@@ -1,6 +1,3 @@
-(define pffi-init (lambda () #t))
-
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) int8)

retropikzel/r7rs-pffi/kawa.scm

@@ -2,8 +2,6 @@
 (define method-handle-lookup (invoke-static java.lang.invoke.MethodHandles 'lookup))
 (define native-linker (invoke-static java.lang.foreign.Linker 'nativeLinker))
 
-(define pffi-init (lambda () #t))
-
 (define value->object
   (lambda (value type)
     (cond ((equal? type 'byte)
@@ -136,10 +134,6 @@
   (lambda (pointer)
     (invoke pointer 'get (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1) 0)))
 
-(define pffi-pointer-dereference
-  (lambda (pointer)
-    (invoke pointer 'get (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1) 0)))
-
 (define pffi-pointer-null
   (lambda ()
     (static-field java.lang.foreign.MemorySegment 'NULL)))

retropikzel/r7rs-pffi/larceny.scm

@@ -1,7 +1,5 @@
 (require 'std-ffi)
 
-(define pffi-init (lambda () #t))
-
 ;; FIXME
 (define pffi-size-of
   (lambda (type)

retropikzel/r7rs-pffi/libffi.scm

@@ -1,2 +0,0 @@
-
-

retropikzel/r7rs-pffi/main.scm

@@ -1,3 +1,26 @@
+(define debug? #f)
+(define (debug msg value)
+  (display "[R7RS-PFFI DEBUG] ")
+  (display msg)
+  (display ": ")
+  (write value)
+  (newline))
+
+(cond-expand
+  ((or chicken5 chicken6)
+    (define-syntax pffi-init
+      (er-macro-transformer
+        (lambda (expr rename compare)
+          '(import (chicken foreign)
+                   (chicken memory))))))
+  (else
+    (define (pffi-init . options)
+      (when (and (assoc 'debug? (car options))
+                 (cdr (assoc 'debug? (car options))))
+        (set! debug? #t))
+      #t)))
+
+;(when (not debug?) (set! debug (lambda (msg value) #t)))
 
 (define pffi-types
   '(int8
@@ -45,21 +68,32 @@
 (cond-expand
   (gambit
     (define-macro
-      (pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
+      (pffi-shared-object-auto-load headers object-name options)
       `(pffi-shared-object-load ,(car headers))))
   (cyclone
     (define-syntax pffi-shared-object-auto-load
       (syntax-rules ()
-        ((pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
+        ((pffi-shared-object-auto-load headers object-name)
+         (pffi-shared-object-auto-load headers object-name (list)))
+        ((pffi-shared-object-auto-load headers object-name options)
          (pffi-shared-object-load headers)))))
   (else
     (define-syntax pffi-shared-object-auto-load
       (syntax-rules ()
-        ((pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
+        ((pffi-shared-object-auto-load headers object-name)
+         (pffi-shared-object-auto-load headers object-name (list)))
+        ((pffi-shared-object-auto-load headers object-name options)
          (cond-expand
            (chicken (pffi-shared-object-load headers))
            (else
-             (let* ((slash (cond-expand (windows (string #\\)) (else "/")))
+             (debug "Options given" options)
+             (let* ((additional-paths (if (assoc 'additional-paths options)
+                                        (cadr (assoc 'additional-paths options))
+                                        (list)))
+                    (additional-versions (if (assoc 'additional-versions options)
+                                           (cadr (assoc 'additional-versions options))
+                                           (list)))
+                    (slash (cond-expand (windows (string #\\)) (else "/")))
                     (auto-load-paths
                       (cond-expand
                         (windows
@@ -131,8 +165,11 @@
                         (windows ".dll")
                         (else ".so")))
                     (shared-object #f))
+               (debug "Auto load paths" paths)
+               (debug "Auto load versions" versions)
                (for-each
                  (lambda (path)
+                   (debug "Checking path" path)
                    (for-each
                      (lambda (version)
                        (let ((library-path (string-append path
@@ -140,9 +177,17 @@
                                                           platform-lib-prefix
                                                           object-name
                                                           platform-file-extension
-                                                          version)))
+                                                          version))
-                         (if (file-exists? library-path)
+                             (library-path-without-suffixes (string-append path
-                           (set! shared-object library-path))))
+                                                                           slash
+                                                                           platform-lib-prefix
+                                                                           object-name)))
+                         (debug "Checking if library exists in" library-path)
+                         (when (file-exists? library-path)
+                           (debug "Library exists, setting to be loaded" library-path)
+                           (cond-expand
+                             (racket (set! shared-object library-path-without-suffixes))
+                             (else (set! shared-object library-path))))))
                      versions))
                  paths)
                (if (not shared-object)

retropikzel/r7rs-pffi/mosh.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-size-of
   (lambda (type)
     (cond ((eq? type 'int8) 1)

retropikzel/r7rs-pffi/racket.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) _int8)
@@ -76,8 +74,11 @@
     (string-copy (cast pointer _pointer _string))))
 
 (define pffi-shared-object-load
-  (lambda (header path)
+  (lambda (header path . options)
-    (ffi-lib path)))
+    (if (and (not (null? options))
+             (assoc 'versions (car options)))
+      (ffi-lib path (mlist->list (append (cadr (assoc 'versions (car options))) (list #f))))
+      (ffi-lib path))))
 
 (define pffi-pointer-free
   (lambda (pointer)

retropikzel/r7rs-pffi/sagittarius.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) 'int8_t)

retropikzel/r7rs-pffi/skint.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-size-of
   (lambda (type)
     (cond ((equal? type 'int8) 1))))

retropikzel/r7rs-pffi/stklos.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-type->native-type
   (lambda (type)
     (cond ((equal? type 'int8) :int)

retropikzel/r7rs-pffi/tr7.scm

@@ -1,5 +1,3 @@
-(define pffi-init (lambda () #t))
-
 (define pffi-size-of
   (lambda (type)
     (cond ((equal? type 'int8) 1))))

retropikzel/r7rs-pffi/ypsilon.scm

@@ -1 +0,0 @@
-(define pffi-init (lambda () #t))