From 19c9c3f802ed1b4819efe05ab8a3df2771eae406 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 31 Jan 2025 12:15:36 +0200 Subject: [PATCH] Fixing the load interface --- Makefile | 9 +--- README.md | 41 ++++++++++++++++--- manifest.scm | 9 ++++ retropikzel/r7rs-pffi/chibi.scm | 2 - retropikzel/r7rs-pffi/chicken5.scm | 5 --- retropikzel/r7rs-pffi/chicken6.scm | 6 --- retropikzel/r7rs-pffi/cyclone.scm | 2 - retropikzel/r7rs-pffi/gambit.scm | 2 - retropikzel/r7rs-pffi/gauche.scm | 2 - retropikzel/r7rs-pffi/gerbil.scm | 2 - retropikzel/r7rs-pffi/guile.scm | 3 -- retropikzel/r7rs-pffi/kawa.scm | 6 --- retropikzel/r7rs-pffi/larceny.scm | 2 - retropikzel/r7rs-pffi/libffi.scm | 2 - retropikzel/r7rs-pffi/main.scm | 59 +++++++++++++++++++++++---- retropikzel/r7rs-pffi/mosh.scm | 2 - retropikzel/r7rs-pffi/racket.scm | 9 ++-- retropikzel/r7rs-pffi/sagittarius.scm | 2 - retropikzel/r7rs-pffi/skint.scm | 2 - retropikzel/r7rs-pffi/stklos.scm | 2 - retropikzel/r7rs-pffi/tr7.scm | 2 - retropikzel/r7rs-pffi/ypsilon.scm | 1 - 22 files changed, 104 insertions(+), 68 deletions(-) create mode 100644 manifest.scm delete mode 100644 retropikzel/r7rs-pffi/libffi.scm diff --git a/Makefile b/Makefile index f391e89..72fc748 100644 --- a/Makefile +++ b/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 \ - -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 + -lffi test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so ${CHIBI} test.scm diff --git a/README.md b/README.md index d5c48a2..01dbfbd 100644 --- a/README.md +++ b/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. diff --git a/manifest.scm b/manifest.scm new file mode 100644 index 0000000..2f43983 --- /dev/null +++ b/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")))) diff --git a/retropikzel/r7rs-pffi/chibi.scm b/retropikzel/r7rs-pffi/chibi.scm index e8d5694..50056fb 100644 --- a/retropikzel/r7rs-pffi/chibi.scm +++ b/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)) diff --git a/retropikzel/r7rs-pffi/chicken5.scm b/retropikzel/r7rs-pffi/chicken5.scm index 3c0a784..5c8f9e8 100644 --- a/retropikzel/r7rs-pffi/chicken5.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/chicken6.scm b/retropikzel/r7rs-pffi/chicken6.scm index 3c0a784..ddd7922 100644 --- a/retropikzel/r7rs-pffi/chicken6.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/cyclone.scm b/retropikzel/r7rs-pffi/cyclone.scm index 057f292..95bda6d 100644 --- a/retropikzel/r7rs-pffi/cyclone.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/gambit.scm b/retropikzel/r7rs-pffi/gambit.scm index 9bbd254..c04bff7 100644 --- a/retropikzel/r7rs-pffi/gambit.scm +++ b/retropikzel/r7rs-pffi/gambit.scm @@ -1,7 +1,5 @@ (c-declare "#include ") -(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));"))) diff --git a/retropikzel/r7rs-pffi/gauche.scm b/retropikzel/r7rs-pffi/gauche.scm index ec960ad..5c6f2f9 100644 --- a/retropikzel/r7rs-pffi/gauche.scm +++ b/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)))) diff --git a/retropikzel/r7rs-pffi/gerbil.scm b/retropikzel/r7rs-pffi/gerbil.scm index 3494b4b..09afe5f 100644 --- a/retropikzel/r7rs-pffi/gerbil.scm +++ b/retropikzel/r7rs-pffi/gerbil.scm @@ -1,5 +1,3 @@ -(define pffi-init (lambda () #t)) - (define pffi-type->native-type (lambda (type) (error "Not defined"))) diff --git a/retropikzel/r7rs-pffi/guile.scm b/retropikzel/r7rs-pffi/guile.scm index 849a4d1..4995190 100644 --- a/retropikzel/r7rs-pffi/guile.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/kawa.scm b/retropikzel/r7rs-pffi/kawa.scm index c7ca2e0..10ed717 100644 --- a/retropikzel/r7rs-pffi/kawa.scm +++ b/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))) diff --git a/retropikzel/r7rs-pffi/larceny.scm b/retropikzel/r7rs-pffi/larceny.scm index 683e0c0..5a53815 100644 --- a/retropikzel/r7rs-pffi/larceny.scm +++ b/retropikzel/r7rs-pffi/larceny.scm @@ -1,7 +1,5 @@ (require 'std-ffi) -(define pffi-init (lambda () #t)) - ;; FIXME (define pffi-size-of (lambda (type) diff --git a/retropikzel/r7rs-pffi/libffi.scm b/retropikzel/r7rs-pffi/libffi.scm deleted file mode 100644 index 139597f..0000000 --- a/retropikzel/r7rs-pffi/libffi.scm +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/retropikzel/r7rs-pffi/main.scm b/retropikzel/r7rs-pffi/main.scm index f9fb1a9..a2f93bf 100644 --- a/retropikzel/r7rs-pffi/main.scm +++ b/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))) - (if (file-exists? library-path) - (set! shared-object library-path)))) + version)) + (library-path-without-suffixes (string-append 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) diff --git a/retropikzel/r7rs-pffi/mosh.scm b/retropikzel/r7rs-pffi/mosh.scm index b2774f2..6055136 100644 --- a/retropikzel/r7rs-pffi/mosh.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/racket.scm b/retropikzel/r7rs-pffi/racket.scm index 28f6188..8cbe524 100644 --- a/retropikzel/r7rs-pffi/racket.scm +++ b/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) - (ffi-lib path))) + (lambda (header path . options) + (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) diff --git a/retropikzel/r7rs-pffi/sagittarius.scm b/retropikzel/r7rs-pffi/sagittarius.scm index 9d41969..7a4b58b 100644 --- a/retropikzel/r7rs-pffi/sagittarius.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/skint.scm b/retropikzel/r7rs-pffi/skint.scm index ec960ad..5c6f2f9 100644 --- a/retropikzel/r7rs-pffi/skint.scm +++ b/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)))) diff --git a/retropikzel/r7rs-pffi/stklos.scm b/retropikzel/r7rs-pffi/stklos.scm index 52dc66c..063e232 100644 --- a/retropikzel/r7rs-pffi/stklos.scm +++ b/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) diff --git a/retropikzel/r7rs-pffi/tr7.scm b/retropikzel/r7rs-pffi/tr7.scm index ec960ad..5c6f2f9 100644 --- a/retropikzel/r7rs-pffi/tr7.scm +++ b/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)))) diff --git a/retropikzel/r7rs-pffi/ypsilon.scm b/retropikzel/r7rs-pffi/ypsilon.scm index 3041685..e69de29 100644 --- a/retropikzel/r7rs-pffi/ypsilon.scm +++ b/retropikzel/r7rs-pffi/ypsilon.scm @@ -1 +0,0 @@ -(define pffi-init (lambda () #t))