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

Add pffi-pointer-address

This commit is contained in:
retropikzel 2025-02-07 08:58:12 +02:00
parent 5d00e06fd1
commit 9c37551414
4 changed files with 39 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
README.md
View File

@ -74,28 +74,28 @@ changing anymore and some implementations are in **beta**.
### Beta ### Beta
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback | | | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------| |--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Guile | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | Guile | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Racket | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | Racket | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Saggittarius | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | Saggittarius | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
### Alpha ### Alpha
| | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback | | | pffi-init | pffi-size-of | pffi-shared-object-auto-load | pffi-shared-object-load | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address |pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-size | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-struct-dereference | pffi-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------| |--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| Chibi | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | X | | | Chibi | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Chicken-5 | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | X | X | | Chicken-5 | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | X |
| Cyclone | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | X | | | Cyclone | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | | X | |
| Gambit | X | X | | | | | | | | | | | | X | X | X | X | X | X | | | | | Gambit | X | X | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gauche | X | | | | | | | | | | | | | X | X | X | X | X | X | | | | | Gauche | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gerbil | X | | | | | | | | | | | | | X | X | X | X | X | X | | | | | Gerbil | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Larceny | X | | | | | | | | | | | | | X | X | X | X | X | X | | | | | Larceny | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Mosh | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | Mosh | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Skint | X | | | | | | | | | | | | | X | X | X | X | X | X | | | | | Skint | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Stklos | X | X | X | X | X | X | X | X | X | | | | | X | X | X | X | X | X | | | | | Stklos | X | X | X | X | X | X | X | | X | X | | | | | X | X | X | X | X | X | | | |
| tr7 | | | | | | | | | | | | | | X | X | X | X | X | X | | | | | tr7 | | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Ypsilon | | | | | | | | | | | | | | X | X | X | X | X | X | | | | | Ypsilon | | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
### Not started ### Not started
@ -206,7 +206,7 @@ keyword. The options are:
- additional-versions - additional-versions
- Search for additional versions of shared object, given shared object "c" and additional - 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. versions "6" "7" on linux the files "libc", "libc.6", "libc.7" are searched for.
- additional-paths - additional-paths
- Give additional paths to search shared objects for - Give additional paths to search shared objects for
@ -215,7 +215,7 @@ Example:
(define libc-stdlib (define libc-stdlib
(cond-expand (cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase")) (windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase"))
(else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions (".6"))))))) (else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions ("6")))))))
##### **pffi-shared-object-load** headers path [options] ##### **pffi-shared-object-load** headers path [options]
@ -233,7 +233,7 @@ Path is the full path of the shared object without any "lib" prefix or ".so/.dll
Options: Options:
- versions - additional-versions
- List of different versions of library to try, for example (list ".0" ".1") - List of different versions of library to try, for example (list ".0" ".1")
##### **pffi-pointer-null** -> pointer ##### **pffi-pointer-null** -> pointer
@ -328,7 +328,7 @@ Defines a new foreign function to be used from Scheme code. For example:
(define libc-stdlib (define libc-stdlib
(cond-expand (cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") (list) "ucrtbase" (list ""))) (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"))))) (else (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" "6")))))
(pffi-define c-puts libc-stdlib 'puts 'int (list 'pointer)) (pffi-define c-puts libc-stdlib 'puts 'int (list 'pointer))
(c-puts "Message brought to you by FFI!") (c-puts "Message brought to you by FFI!")
@ -340,7 +340,7 @@ Defines a new Sceme function to be used as callback to C code. For example:
(define libc-stdlib (define libc-stdlib
(cond-expand (cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") (list) "ucrtbase" (list ""))) (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"))))) (else (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" "6")))))
; Define C function that takes a callback ; Define C function that takes a callback
(pffi-define qsort libc-stdlib 'qsort 'void (list 'pointer 'int 'int 'callback)) (pffi-define qsort libc-stdlib 'qsort 'void (list 'pointer 'int 'int 'callback))

4
retropikzel/r7rs-pffi.sld
View File

@ -52,6 +52,7 @@
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
pffi-pointer-address
pffi-pointer? pffi-pointer?
pffi-pointer-free pffi-pointer-free
pffi-pointer-set! pffi-pointer-set!
@ -237,6 +238,7 @@
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
pffi-pointer-address
pffi-pointer? pffi-pointer?
pffi-pointer-free pffi-pointer-free
pffi-pointer-set! pffi-pointer-set!
@ -366,6 +368,7 @@
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
pffi-pointer-address
pffi-pointer? pffi-pointer?
pffi-pointer-free pffi-pointer-free
pffi-pointer-set! pffi-pointer-set!
@ -397,6 +400,7 @@
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
pffi-pointer-address
pffi-pointer? pffi-pointer?
pffi-pointer-free pffi-pointer-free
pffi-pointer-set! pffi-pointer-set!

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

@ -135,7 +135,7 @@
"/usr/pkg/lib"))))) "/usr/pkg/lib")))))
(auto-load-versions (list "")) (auto-load-versions (list ""))
(paths (append auto-load-paths additional-paths)) (paths (append auto-load-paths additional-paths))
(versions (append auto-load-versions additional-versions)) (versions (append additional-versions auto-load-versions))
(platform-lib-prefix (platform-lib-prefix
(cond-expand (cond-expand
;(racket (if (equal? (system-type 'os) 'windows) "" "lib")) ;(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
@ -167,13 +167,11 @@
slash slash
platform-lib-prefix platform-lib-prefix
object-name))) object-name)))
(when (file-exists? library-path) (when (and (not shared-object)
(file-exists? library-path))
(set! shared-object (set! shared-object
(cond-expand (racket library-path-without-suffixes) (cond-expand (racket library-path-without-suffixes)
(else library-path))) (else library-path))))))
(display "Shared object is now: ")
(display shared-object)
(newline))))
versions)) versions))
paths) paths)
(if (not shared-object) (if (not shared-object)
@ -182,4 +180,6 @@
(cons 'paths paths) (cons 'paths paths)
(cons 'platform-file-extension platform-file-extension) (cons 'platform-file-extension platform-file-extension)
(cons 'versions versions))) (cons 'versions versions)))
(pffi-shared-object-load headers shared-object)))))))))) (pffi-shared-object-load headers
shared-object
`((additional-versions ,versions))))))))))))

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

@ -77,8 +77,10 @@
(define pffi-shared-object-load (define pffi-shared-object-load
(lambda (header path . options) (lambda (header path . options)
(if (and (not (null? options)) (if (and (not (null? options))
(assoc 'versions (car options))) (assoc 'additional-versions (car options)))
(ffi-lib path (mlist->list (append (cadr (assoc 'versions (car options))) (list #f)))) (ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
(car options)))
(list #f))))
(ffi-lib path)))) (ffi-lib path))))
(define pffi-pointer-free (define pffi-pointer-free