Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix auto-load versions and paths handling

This commit is contained in:
retropikzel 2025-01-31 18:23:57 +02:00
parent 27c2d17fd1
commit 5df5638f6b
7 changed files with 62 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
README.md
View File

@ -113,7 +113,7 @@ Usage recommended.
| pffi-struct-offset-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-set! | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-dereference | | | | | | | | | | | | X | | | | |
| pffi-struct-dereference | | X | | | | | X | | | X | X | X | | | | |
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |
@ -126,14 +126,19 @@ Usage recommended.
- Will work on nodejs by using some C FFI library from npm
- Javascript side needs design
- [MIT-Scheme](https://www.gnu.org/software/mit-scheme/)
- Need to study the implementation more
- [s7](https://scheme.fail://ccrma.stanford.edu/software/snd/snd/s7.html)
- Propably does not need FFI?
- [Airship](https://gitlab.com/mbabich/airship-scheme)
- Need to study the implementation more
- [Other gambit targets](https://gambitscheme.org/)
- Gambit compiles to different targets other than C too, for example Javascript. It would be cool
and interesting to see if this FFI could also support some of those
- When LIPS and Biwascheme Javascript side is done then Gambit should be done too
- [s48-r7rs](https://codeberg.org/prescheme/s48-r7rs)
- Need to study the implementation more
- [prescheme](https://codeberg.org/prescheme/prescheme)
- Need to study the implementation more
- [Loko](https://scheme.fail/)
- Desires no C interop, I can respect that
@ -142,7 +147,7 @@ Usage recommended.
### Usage notes
- Chibi
- Install libffi-dev libc-dev
- Install libffi-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
@ -190,16 +195,11 @@ 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** [options]
##### **pffi-init**
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.

3
retropikzel/r7rs-pffi.sld
View File

@ -64,6 +64,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback))
(chicken6
@ -247,6 +248,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback))
(kawa
@ -341,6 +343,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback))
(racket

8
retropikzel/r7rs-pffi/chicken5.scm
View File

@ -145,10 +145,6 @@
(lambda (pointer)
(pointer->address pointer)))
(define pffi-pointer-dereference
(lambda (pointer)
(pointer->address pointer)))
(define pffi-pointer-null
(lambda ()
(address->pointer 0)))
@ -248,3 +244,7 @@
((equal? type 'double) (pointer-f64-ref (pointer+ pointer offset)))
((equal? type 'pointer) (address->pointer (pointer-u64-ref (pointer+ pointer offset)))))))
(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

9
retropikzel/r7rs-pffi/guile.scm
View File

@ -21,6 +21,7 @@
((equal? type 'pointer) '*)
((equal? type 'void) void)
((equal? type 'callback) '*)
((equal? type 'struct) '*)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer?
@ -56,10 +57,6 @@
(lambda (pointer)
(pointer-address pointer)))
(define pffi-pointer-dereference
(lambda (pointer)
(dereference-pointer pointer)))
(define pffi-pointer-null
(lambda ()
(make-pointer 0)))
@ -130,3 +127,7 @@
((equal? type 'double) (bytevector-ieee-double-ref p offset (native-endianness)))
((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type))))
((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type)))))))))
(define pffi-struct-dereference
(lambda (struct)
(dereference-pointer (pffi-struct-pointer struct))))

80
retropikzel/r7rs-pffi/main.scm
View File

@ -1,26 +1,13 @@
(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))))))
(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-init
(lambda () (+ 1 1)))))
(define pffi-types
'(int8
@ -62,9 +49,6 @@
(for-each splitter str-l)
res)))
(define auto-load-versions (list ""))
(cond-expand
(gambit
(define-macro
@ -86,7 +70,6 @@
(cond-expand
(chicken (pffi-shared-object-load headers))
(else
(debug "Options given" options)
(let* ((additional-paths (if (assoc 'additional-paths options)
(cadr (assoc 'additional-paths options))
(list)))
@ -149,45 +132,48 @@
"/usr/lib"
"/usr/lib64"
; NetBSD
"/usr/pkg/lib"
)))))
(auto-load-versions (list))
"/usr/pkg/lib")))))
(auto-load-versions (list ""))
(paths (append auto-load-paths additional-paths))
(versions (append auto-load-versions additional-versions))
(platform-lib-prefix
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
;(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
(windows "")
(else "lib")))
(platform-file-extension
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
;(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
(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
slash
platform-lib-prefix
object-name
platform-file-extension
version))
(library-path-without-suffixes (string-append path
slash
platform-lib-prefix
object-name)))
(debug "Checking if library exists in" library-path)
(let ((library-path
(string-append path
slash
platform-lib-prefix
object-name
platform-file-extension
(if (string=? version "")
""
(string-append
(cond-expand (windows ".") ; FIXME
(else "."))
version))))
(library-path-without-suffixes (string-append path
slash
platform-lib-prefix
object-name)))
(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))))))
(set! shared-object
(cond-expand (racket library-path-without-suffixes)
(else library-path)))
(display "Shared object is now: ")
(display shared-object)
(newline))))
versions))
paths)
(if (not shared-object)

5
retropikzel/r7rs-pffi/mosh.scm
View File

@ -129,6 +129,7 @@
((equal? type 'string) 'char*)
((equal? type 'void) 'void)
((equal? type 'callback) 'void*)
((equal? type 'struct) 'void*)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define-syntax pffi-define
@ -147,3 +148,7 @@
(make-c-callback (pffi-type->native-type return-type)
(map pffi-type->native-type argument-types)
procedure)))))
(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

8
test.scm
View File

@ -340,15 +340,15 @@
(define libc-stdlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") (list) "ucrtbase" (list "")))
(else (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" ".6")))))
(windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase"))
(else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions ("0" "6")))))))
(debug libc-stdlib)
(define c-testlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "libtest.h") (list ".") "test" (list "")))
(else (pffi-shared-object-auto-load (list "libtest.h") (list ".") "test" (list "")))))
(windows (pffi-shared-object-auto-load (list "libtest.h") "test" '((additional-paths (".")))))
(else (pffi-shared-object-auto-load (list "libtest.h") "test" '((additional-paths (".")))))))
(debug c-testlib)