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

Fixing the load interface

This commit is contained in:
retropikzel 2025-01-31 12:15:36 +02:00
parent efad73ac55
commit 19c9c3f802
22 changed files with 104 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile
View File

@ -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

41
README.md
View File

@ -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.

9
manifest.scm Normal file
View File

@ -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"))))

2
retropikzel/r7rs-pffi/chibi.scm
View File

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

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

@ -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)

6
retropikzel/r7rs-pffi/chicken6.scm
View File

@ -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)

2
retropikzel/r7rs-pffi/cyclone.scm
View File

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

2
retropikzel/r7rs-pffi/gambit.scm
View File

@ -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));")))

2
retropikzel/r7rs-pffi/gauche.scm
View File

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

2
retropikzel/r7rs-pffi/gerbil.scm
View File

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

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

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

6
retropikzel/r7rs-pffi/kawa.scm
View File

@ -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)))

2
retropikzel/r7rs-pffi/larceny.scm
View File

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

2
retropikzel/r7rs-pffi/libffi.scm
View File

@ -1,2 +0,0 @@

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

@ -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)

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

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

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

@ -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)

2
retropikzel/r7rs-pffi/sagittarius.scm
View File

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

2
retropikzel/r7rs-pffi/skint.scm
View File

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

2
retropikzel/r7rs-pffi/stklos.scm
View File

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

2
retropikzel/r7rs-pffi/tr7.scm
View File

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

1
retropikzel/r7rs-pffi/ypsilon.scm
View File

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