Backup
This commit is contained in:
parent
20a05a5dc0
commit
bbd51e93e1
38
README.md
38
README.md
|
|
@ -38,25 +38,25 @@ guarantees are being made just yet.
|
|||
|
||||
## Implementation table
|
||||
|
||||
| | Chibi | Chicken | Cyclone | Gambit | Gauche | Gerbil | Guile | Kawa | Larceny | Mosh | Racket | Sagittarius | Skint | STklos | tr7 | Ypsilon |
|
||||
| ------------------------------- | ----- | ------- | ------- | ------- | ------ | ------ | ----- | ---- | ------- | ---- | ------ | ----------- | ----- | ------ | --- | ------- |
|
||||
| pffi-init | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | |
|
||||
| pffi-size-of | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-auto-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-allocate | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-free | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-set! | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer-get | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-string->pointer | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer->string | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |
|
||||
| pffi-pointer-address | | X | | | | | X | | | | X | X | | | | |
|
||||
| pffi-pointer-dereference | | | | | | | X | | | | X | X | | | | |
|
||||
| | Chibi | Chicken 5 | Cyclone | Gambit | Gauche | Gerbil | Guile | Kawa | Larceny | Mosh | Racket | Sagittarius | Skint | STklos | tr7 | Ypsilon |
|
||||
| ------------------------------- | ----- | --------- | ------- | ------- | ------ | ------ | ----- | ---- | ------- | ---- | ------ | ----------- | ----- | ------ | --- | ------- |
|
||||
| pffi-init | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | |
|
||||
| pffi-size-of | X | X | X | X | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-auto-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-allocate | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-free | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-set! | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer-get | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-string->pointer | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer->string | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |
|
||||
| pffi-pointer-address | | X | | | | | X | | | | X | X | | | | |
|
||||
| pffi-pointer-dereference | | | | | | | X | | | | X | X | | | | |
|
||||
|
||||
### Usage notes
|
||||
|
||||
|
|
|
|||
|
|
@ -91,9 +91,9 @@
|
|||
(scheme process-context)
|
||||
(only (gambit) c-declare c-lambda c-define))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;pffi-shared-object-load
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
pffi-shared-object-load
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
;pffi-pointer-allocate
|
||||
|
|
|
|||
|
|
@ -42,104 +42,109 @@
|
|||
|
||||
(define auto-load-versions (list ""))
|
||||
|
||||
(define-syntax pffi-shared-object-auto-load
|
||||
(syntax-rules ()
|
||||
((pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
|
||||
(cond-expand
|
||||
(cyclone (pffi-shared-object-load headers))
|
||||
(chicken (pffi-shared-object-load headers))
|
||||
(gambit (pffi-shared-object-load headers))
|
||||
(else
|
||||
(let* ((slash (cond-expand (windows (string #\\)) (else "/")))
|
||||
(auto-load-paths
|
||||
(cond-expand
|
||||
(windows
|
||||
(append
|
||||
(if (get-environment-variable "SYSTEM")
|
||||
(list (get-environment-variable "SYSTEM"))
|
||||
(list))
|
||||
(if (get-environment-variable "WINDIR")
|
||||
(list (get-environment-variable "WINDIR"))
|
||||
(list))
|
||||
(if (get-environment-variable "WINEDLLDIR0")
|
||||
(list (get-environment-variable "WINEDLLDIR0"))
|
||||
(list))
|
||||
(if (get-environment-variable "SystemRoot")
|
||||
(list (string-append
|
||||
(get-environment-variable "SystemRoot")
|
||||
slash
|
||||
"system32"))
|
||||
(list))
|
||||
(list ".")
|
||||
(if (get-environment-variable "PATH")
|
||||
(string-split (get-environment-variable "PATH") #\;)
|
||||
(list))
|
||||
(if (get-environment-variable "PWD")
|
||||
(list (get-environment-variable "PWD"))
|
||||
(list))))
|
||||
(else
|
||||
(append
|
||||
; Guix
|
||||
(list (if (get-environment-variable "GUIX_ENVIRONMENT")
|
||||
(string-append (get-environment-variable "GUIX_ENVIRONMENT") slash "lib")
|
||||
"")
|
||||
"/run/current-system/profile/lib")
|
||||
; Debian
|
||||
(if (get-environment-variable "LD_LIBRARY_PATH")
|
||||
(string-split (get-environment-variable "LD_LIBRARY_PATH") #\:)
|
||||
(list))
|
||||
(list
|
||||
;;; x86-64
|
||||
; Debian
|
||||
"/lib/x86_64-linux-gnu"
|
||||
"/usr/lib/x86_64-linux-gnu"
|
||||
"/usr/local/lib"
|
||||
; Fedora/Alpine
|
||||
"/usr/lib"
|
||||
"/usr/lib64"
|
||||
;;; aarch64
|
||||
; Debian
|
||||
"/lib/aarch64-linux-gnu"
|
||||
"/usr/lib/aarch64-linux-gnu"
|
||||
"/usr/local/lib"
|
||||
; Fedora/Alpine
|
||||
"/usr/lib"
|
||||
"/usr/lib64"
|
||||
; NetBSD
|
||||
"/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"))
|
||||
(windows "")
|
||||
(else "lib")))
|
||||
(platform-file-extension
|
||||
(cond-expand
|
||||
(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
|
||||
(windows ".dll")
|
||||
(else ".so")))
|
||||
(shared-object #f))
|
||||
(for-each
|
||||
(lambda (path)
|
||||
(cond-expand
|
||||
(gambit
|
||||
(define-macro
|
||||
(pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
|
||||
`(pffi-shared-object-load ,(car headers))))
|
||||
(else
|
||||
(define-syntax pffi-shared-object-auto-load
|
||||
(syntax-rules ()
|
||||
((pffi-shared-object-auto-load headers additional-paths object-name additional-versions)
|
||||
(cond-expand
|
||||
(cyclone (pffi-shared-object-load headers))
|
||||
(chicken (pffi-shared-object-load headers))
|
||||
(else
|
||||
(let* ((slash (cond-expand (windows (string #\\)) (else "/")))
|
||||
(auto-load-paths
|
||||
(cond-expand
|
||||
(windows
|
||||
(append
|
||||
(if (get-environment-variable "SYSTEM")
|
||||
(list (get-environment-variable "SYSTEM"))
|
||||
(list))
|
||||
(if (get-environment-variable "WINDIR")
|
||||
(list (get-environment-variable "WINDIR"))
|
||||
(list))
|
||||
(if (get-environment-variable "WINEDLLDIR0")
|
||||
(list (get-environment-variable "WINEDLLDIR0"))
|
||||
(list))
|
||||
(if (get-environment-variable "SystemRoot")
|
||||
(list (string-append
|
||||
(get-environment-variable "SystemRoot")
|
||||
slash
|
||||
"system32"))
|
||||
(list))
|
||||
(list ".")
|
||||
(if (get-environment-variable "PATH")
|
||||
(string-split (get-environment-variable "PATH") #\;)
|
||||
(list))
|
||||
(if (get-environment-variable "PWD")
|
||||
(list (get-environment-variable "PWD"))
|
||||
(list))))
|
||||
(else
|
||||
(append
|
||||
; Guix
|
||||
(list (if (get-environment-variable "GUIX_ENVIRONMENT")
|
||||
(string-append (get-environment-variable "GUIX_ENVIRONMENT") slash "lib")
|
||||
"")
|
||||
"/run/current-system/profile/lib")
|
||||
; Debian
|
||||
(if (get-environment-variable "LD_LIBRARY_PATH")
|
||||
(string-split (get-environment-variable "LD_LIBRARY_PATH") #\:)
|
||||
(list))
|
||||
(list
|
||||
;;; x86-64
|
||||
; Debian
|
||||
"/lib/x86_64-linux-gnu"
|
||||
"/usr/lib/x86_64-linux-gnu"
|
||||
"/usr/local/lib"
|
||||
; Fedora/Alpine
|
||||
"/usr/lib"
|
||||
"/usr/lib64"
|
||||
;;; aarch64
|
||||
; Debian
|
||||
"/lib/aarch64-linux-gnu"
|
||||
"/usr/lib/aarch64-linux-gnu"
|
||||
"/usr/local/lib"
|
||||
; Fedora/Alpine
|
||||
"/usr/lib"
|
||||
"/usr/lib64"
|
||||
; NetBSD
|
||||
"/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"))
|
||||
(windows "")
|
||||
(else "lib")))
|
||||
(platform-file-extension
|
||||
(cond-expand
|
||||
(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
|
||||
(windows ".dll")
|
||||
(else ".so")))
|
||||
(shared-object #f))
|
||||
(for-each
|
||||
(lambda (version)
|
||||
(let ((library-path (string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name
|
||||
platform-file-extension
|
||||
version)))
|
||||
(if (file-exists? library-path)
|
||||
(set! shared-object library-path))))
|
||||
versions))
|
||||
paths)
|
||||
(if (not shared-object)
|
||||
(error "Could not load shared object"
|
||||
(list (cons 'object object-name)
|
||||
(cons 'paths paths)
|
||||
(cons 'platform-file-extension platform-file-extension)
|
||||
(cons 'versions versions)))
|
||||
(pffi-shared-object-load headers shared-object))))))))
|
||||
(lambda (path)
|
||||
(for-each
|
||||
(lambda (version)
|
||||
(let ((library-path (string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name
|
||||
platform-file-extension
|
||||
version)))
|
||||
(if (file-exists? library-path)
|
||||
(set! shared-object library-path))))
|
||||
versions))
|
||||
paths)
|
||||
(if (not shared-object)
|
||||
(error "Could not load shared object"
|
||||
(list (cons 'object object-name)
|
||||
(cons 'paths paths)
|
||||
(cons 'platform-file-extension platform-file-extension)
|
||||
(cons 'versions versions)))
|
||||
(pffi-shared-object-load headers shared-object))))))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue