Move chicken to pffi-define-library
This commit is contained in:
parent
27cc998f35
commit
993588e286
2
Makefile
2
Makefile
|
|
@ -59,7 +59,7 @@ test-compile-library: tests/libtest.so libtest.a libtest.o
|
|||
SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld
|
||||
|
||||
test-compiler-compliance-compile: test-compile-library
|
||||
SCHEME=${SCHEME} CFLAGS="-I../include -L.." LDFLAGS="-ltest" compile-r7rs -I . tests/compliance.scm
|
||||
SCHEME=${SCHEME} CFLAGS="-I./include -L." LDFLAGS="-ltest -L." compile-r7rs -I . tests/compliance.scm
|
||||
./tests/compliance
|
||||
|
||||
test-compiler-compliance: test-compiler-compliance-compile
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -49,7 +49,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -82,7 +82,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -111,7 +111,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -171,7 +171,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -200,7 +200,7 @@
|
|||
;pffi-size-of
|
||||
pffi-type?
|
||||
;pffi-align-of
|
||||
;pffi-load
|
||||
;pffi-define-library
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
;pffi-pointer-allocate
|
||||
|
|
@ -231,7 +231,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -259,7 +259,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -294,7 +294,7 @@
|
|||
;pffi-size-of
|
||||
pffi-type?
|
||||
;pffi-align-of
|
||||
;pffi-load
|
||||
;pffi-define-library
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
;pffi-pointer-allocate
|
||||
|
|
@ -323,7 +323,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -356,7 +356,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -386,7 +386,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -414,7 +414,7 @@
|
|||
;pffi-size-of
|
||||
pffi-type?
|
||||
;pffi-align-of
|
||||
;pffi-load
|
||||
;pffi-define-library
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
;pffi-pointer-allocate
|
||||
|
|
@ -443,7 +443,7 @@
|
|||
pffi-size-of
|
||||
pffi-type?
|
||||
pffi-align-of
|
||||
pffi-load
|
||||
pffi-define-library
|
||||
pffi-pointer-null
|
||||
pffi-pointer-null?
|
||||
pffi-pointer-allocate
|
||||
|
|
@ -472,7 +472,7 @@
|
|||
;pffi-size-of
|
||||
pffi-type?
|
||||
;pffi-align-of
|
||||
;pffi-load
|
||||
;pffi-define-library
|
||||
;pffi-shared-object-load
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
|
|
@ -501,7 +501,7 @@
|
|||
;pffi-size-of
|
||||
pffi-type?
|
||||
;pffi-align-of
|
||||
;pffi-load
|
||||
;pffi-define-library
|
||||
;pffi-pointer-null
|
||||
;pffi-pointer-null?
|
||||
;pffi-pointer-allocate
|
||||
|
|
|
|||
|
|
@ -79,9 +79,11 @@
|
|||
(string-copy (cast pointer _pointer _string))))
|
||||
|
||||
(define pffi-shared-object-load
|
||||
(lambda (header path . options)
|
||||
(lambda (header path options)
|
||||
(write options)
|
||||
(newline)
|
||||
(if (and (not (null? options))
|
||||
(assoc 'additional-versions (car options)))
|
||||
(assoc 'additional-versions options))
|
||||
(ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
|
||||
(car options)))
|
||||
(list #f))))
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
(define-syntax pffi-define
|
||||
(syntax-rules ()
|
||||
((pffi-define scheme-name shared-object c-name return-type argument-types)
|
||||
((_ scheme-name shared-object c-name return-type argument-types)
|
||||
(define scheme-name
|
||||
(make-c-function shared-object
|
||||
(pffi-type->native-type return-type)
|
||||
|
|
@ -102,7 +102,7 @@
|
|||
(pointer->string pointer)))
|
||||
|
||||
(define pffi-shared-object-load
|
||||
(lambda (headers path . options)
|
||||
(lambda (headers path options)
|
||||
(open-shared-library path)))
|
||||
|
||||
(define pffi-pointer-free
|
||||
|
|
|
|||
|
|
@ -91,138 +91,149 @@
|
|||
((or chicken cyclone)
|
||||
(define-syntax pffi-define-library
|
||||
(syntax-rules ()
|
||||
((_ headers object-name . options)
|
||||
(pffi-shared-object-load headers)))))
|
||||
((_ scheme-name headers object-name . options)
|
||||
(begin
|
||||
(define scheme-name #t)
|
||||
(pffi-shared-object-load headers))))))
|
||||
(else
|
||||
(define pffi-define-library
|
||||
(lambda (headers object-name . options)
|
||||
(let* ((additional-paths (if (assoc 'additional-paths options)
|
||||
(cdr (assoc 'additional-paths options))
|
||||
(list)))
|
||||
(additional-versions (if (assoc 'additional-versions options)
|
||||
(map (lambda (version)
|
||||
(if (number? version)
|
||||
(number->string version)
|
||||
version))
|
||||
(cdr (assoc 'additional-versions options)))
|
||||
(define-syntax pffi-define-library
|
||||
(syntax-rules ()
|
||||
((_ scheme-name headers object-name options)
|
||||
(define scheme-name #t))))
|
||||
#;(define-syntax pffi-define-library-old
|
||||
(syntax-rules ()
|
||||
((_ scheme-name headers object-name options)
|
||||
(define scheme-name
|
||||
(let* ((additional-paths (if (assoc 'additional-paths options)
|
||||
(cdr (assoc 'additional-paths options))
|
||||
(list)))
|
||||
(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 additional-versions auto-load-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)
|
||||
(searched-paths (list)))
|
||||
(for-each
|
||||
(lambda (path)
|
||||
(for-each
|
||||
(lambda (version)
|
||||
(let ((library-path
|
||||
(string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name
|
||||
(cond-expand
|
||||
(windows "")
|
||||
(else platform-file-extension))
|
||||
(if (string=? version "")
|
||||
""
|
||||
(string-append
|
||||
(cond-expand (windows "-")
|
||||
(else "."))
|
||||
version))
|
||||
(cond-expand
|
||||
(windows platform-file-extension)
|
||||
(else ""))))
|
||||
(library-path-without-suffixes (string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name)))
|
||||
(set! searched-paths (append searched-paths (list library-path)))
|
||||
(when (and (not shared-object)
|
||||
(file-exists? library-path))
|
||||
(set! shared-object
|
||||
(cond-expand (racket library-path-without-suffixes)
|
||||
(else library-path))))))
|
||||
versions))
|
||||
paths)
|
||||
(if (not shared-object)
|
||||
(begin
|
||||
(display "Could not load shared object: ")
|
||||
(write (list (cons 'object object-name)
|
||||
(cons 'paths paths)
|
||||
(cons 'platform-file-extension platform-file-extension)
|
||||
(cons 'versions versions)))
|
||||
(newline)
|
||||
(display "Searched paths: ")
|
||||
(write searched-paths)
|
||||
(newline)
|
||||
(exit 1))
|
||||
(pffi-shared-object-load headers
|
||||
shared-object
|
||||
`((additional-versions ,versions)))))))))
|
||||
(additional-versions (if (assoc 'additional-versions options)
|
||||
(map (lambda (version)
|
||||
(if (number? version)
|
||||
(number->string version)
|
||||
version))
|
||||
(cdr (assoc 'additional-versions options)))
|
||||
(list)))
|
||||
(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 additional-versions auto-load-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)
|
||||
(searched-paths (list)))
|
||||
(display "HERE: ")
|
||||
(write additional-versions)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (path)
|
||||
(for-each
|
||||
(lambda (version)
|
||||
(let ((library-path
|
||||
(string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name
|
||||
(cond-expand
|
||||
(windows "")
|
||||
(else platform-file-extension))
|
||||
(if (string=? version "")
|
||||
""
|
||||
(string-append
|
||||
(cond-expand (windows "-")
|
||||
(else "."))
|
||||
version))
|
||||
(cond-expand
|
||||
(windows platform-file-extension)
|
||||
(else ""))))
|
||||
(library-path-without-suffixes (string-append path
|
||||
slash
|
||||
platform-lib-prefix
|
||||
object-name)))
|
||||
(set! searched-paths (append searched-paths (list library-path)))
|
||||
(when (and (not shared-object)
|
||||
(file-exists? library-path))
|
||||
(set! shared-object
|
||||
(cond-expand (racket library-path-without-suffixes)
|
||||
(else library-path))))))
|
||||
versions))
|
||||
paths)
|
||||
(if (not shared-object)
|
||||
(begin
|
||||
(display "Could not load shared object: ")
|
||||
(write (list (cons 'object object-name)
|
||||
(cons 'paths paths)
|
||||
(cons 'platform-file-extension platform-file-extension)
|
||||
(cons 'versions versions)))
|
||||
(newline)
|
||||
(display "Searched paths: ")
|
||||
(write searched-paths)
|
||||
(newline)
|
||||
(exit 1))
|
||||
(pffi-shared-object-load headers
|
||||
shared-object
|
||||
`((additional-versions ,versions)))))))))))
|
||||
|
|
|
|||
|
|
@ -406,20 +406,20 @@
|
|||
(pffi-define-library libc-stdlib
|
||||
(list "stdlib.h")
|
||||
(cond-expand (windows "ucrtbase") (else "c"))
|
||||
'(additional-versions . ("0" "6")))
|
||||
'((additional-versions . ("0" "6"))))
|
||||
|
||||
(debug libc-stdlib)
|
||||
|
||||
(pffi-define-library libc-stdio
|
||||
(list "stdio.h")
|
||||
(cond-expand (windows "ucrtbase") (else "c"))
|
||||
'(additional-versions . ("0" "6")))
|
||||
'((additional-versions . ("0" "6"))))
|
||||
(debug libc-stdio)
|
||||
|
||||
(pffi-define-library c-testlib
|
||||
(list "libtest.h")
|
||||
"test"
|
||||
'(additional-paths . (".")))
|
||||
'((additional-paths . ("."))))
|
||||
|
||||
(debug c-testlib)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue