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

View File

@ -74,28 +74,28 @@ changing anymore and some implementations are in **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 |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| 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 |
| Saggittarius | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| | 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 |
| 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 |
### 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 |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------------------|-------------|----------------------|
| 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 |
| 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 | | | |
| Gauche | X | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gerbil | 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 |
| Skint | 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 | | | |
| Ypsilon | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| | 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 | |
| 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 | |
| Gambit | X | X | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gauche | X | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
| Gerbil | 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 |
| Skint | 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 | | | |
| Ypsilon | | | | | | | | | | | | | | | X | X | X | X | X | X | | | |
### Not started
@ -206,7 +206,7 @@ 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.
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
@ -215,7 +215,7 @@ 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")))))))
(else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions ("6")))))))
##### **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:
- versions
- additional-versions
- List of different versions of library to try, for example (list ".0" ".1")
##### **pffi-pointer-null** -> pointer
@ -328,7 +328,7 @@ Defines a new foreign function to be used from Scheme code. For example:
(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")))))
(else (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" "6")))))
(pffi-define c-puts libc-stdlib 'puts 'int (list 'pointer))
(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
(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")))))
(else (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" "6")))))
; Define C function that takes a callback
(pffi-define qsort libc-stdlib 'qsort 'void (list 'pointer 'int 'int 'callback))

View File

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

View File

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

View File

@ -77,8 +77,10 @@
(define pffi-shared-object-load
(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))))
(assoc 'additional-versions (car options)))
(ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
(car options)))
(list #f))))
(ffi-lib path))))
(define pffi-pointer-free