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

Move chicken to pffi-define-library

This commit is contained in:
retropikzel 2025-03-22 17:39:54 +02:00
parent 27cc998f35
commit 993588e286
6 changed files with 170 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -59,7 +59,7 @@ test-compile-library: tests/libtest.so libtest.a libtest.o
SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld
test-compiler-compliance-compile: test-compile-library 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 ./tests/compliance
test-compiler-compliance: test-compiler-compliance-compile test-compiler-compliance: test-compiler-compliance-compile

32
retropikzel/pffi.sld
View File

@ -13,7 +13,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -49,7 +49,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -82,7 +82,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -111,7 +111,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -171,7 +171,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -200,7 +200,7 @@
;pffi-size-of ;pffi-size-of
pffi-type? pffi-type?
;pffi-align-of ;pffi-align-of
;pffi-load ;pffi-define-library
;pffi-pointer-null ;pffi-pointer-null
;pffi-pointer-null? ;pffi-pointer-null?
;pffi-pointer-allocate ;pffi-pointer-allocate
@ -231,7 +231,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -259,7 +259,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -294,7 +294,7 @@
;pffi-size-of ;pffi-size-of
pffi-type? pffi-type?
;pffi-align-of ;pffi-align-of
;pffi-load ;pffi-define-library
;pffi-pointer-null ;pffi-pointer-null
;pffi-pointer-null? ;pffi-pointer-null?
;pffi-pointer-allocate ;pffi-pointer-allocate
@ -323,7 +323,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -356,7 +356,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -386,7 +386,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -414,7 +414,7 @@
;pffi-size-of ;pffi-size-of
pffi-type? pffi-type?
;pffi-align-of ;pffi-align-of
;pffi-load ;pffi-define-library
;pffi-pointer-null ;pffi-pointer-null
;pffi-pointer-null? ;pffi-pointer-null?
;pffi-pointer-allocate ;pffi-pointer-allocate
@ -443,7 +443,7 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
pffi-pointer-null pffi-pointer-null
pffi-pointer-null? pffi-pointer-null?
pffi-pointer-allocate pffi-pointer-allocate
@ -472,7 +472,7 @@
;pffi-size-of ;pffi-size-of
pffi-type? pffi-type?
;pffi-align-of ;pffi-align-of
;pffi-load ;pffi-define-library
;pffi-shared-object-load ;pffi-shared-object-load
;pffi-pointer-null ;pffi-pointer-null
;pffi-pointer-null? ;pffi-pointer-null?
@ -501,7 +501,7 @@
;pffi-size-of ;pffi-size-of
pffi-type? pffi-type?
;pffi-align-of ;pffi-align-of
;pffi-load ;pffi-define-library
;pffi-pointer-null ;pffi-pointer-null
;pffi-pointer-null? ;pffi-pointer-null?
;pffi-pointer-allocate ;pffi-pointer-allocate

6
retropikzel/pffi/racket.scm
View File

@ -79,9 +79,11 @@
(string-copy (cast pointer _pointer _string)))) (string-copy (cast pointer _pointer _string))))
(define pffi-shared-object-load (define pffi-shared-object-load
(lambda (header path . options) (lambda (header path options)
(write options)
(newline)
(if (and (not (null? options)) (if (and (not (null? options))
(assoc 'additional-versions (car options))) (assoc 'additional-versions options))
(ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions (ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
(car options))) (car options)))
(list #f)))) (list #f))))

4
retropikzel/pffi/sagittarius.scm
View File

@ -32,7 +32,7 @@
(define-syntax pffi-define (define-syntax pffi-define
(syntax-rules () (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 (define scheme-name
(make-c-function shared-object (make-c-function shared-object
(pffi-type->native-type return-type) (pffi-type->native-type return-type)
@ -102,7 +102,7 @@
(pointer->string pointer))) (pointer->string pointer)))
(define pffi-shared-object-load (define pffi-shared-object-load
(lambda (headers path . options) (lambda (headers path options)
(open-shared-library path))) (open-shared-library path)))
(define pffi-pointer-free (define pffi-pointer-free

21
retropikzel/pffi/shared/main.scm
View File

@ -91,11 +91,19 @@
((or chicken cyclone) ((or chicken cyclone)
(define-syntax pffi-define-library (define-syntax pffi-define-library
(syntax-rules () (syntax-rules ()
((_ headers object-name . options) ((_ scheme-name headers object-name . options)
(pffi-shared-object-load headers))))) (begin
(define scheme-name #t)
(pffi-shared-object-load headers))))))
(else (else
(define pffi-define-library (define-syntax pffi-define-library
(lambda (headers object-name . options) (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) (let* ((additional-paths (if (assoc 'additional-paths options)
(cdr (assoc 'additional-paths options)) (cdr (assoc 'additional-paths options))
(list))) (list)))
@ -178,6 +186,9 @@
(else ".so"))) (else ".so")))
(shared-object #f) (shared-object #f)
(searched-paths (list))) (searched-paths (list)))
(display "HERE: ")
(write additional-versions)
(newline)
(for-each (for-each
(lambda (path) (lambda (path)
(for-each (for-each
@ -225,4 +236,4 @@
(exit 1)) (exit 1))
(pffi-shared-object-load headers (pffi-shared-object-load headers
shared-object shared-object
`((additional-versions ,versions))))))))) `((additional-versions ,versions)))))))))))

6
tests/compliance.scm
View File

@ -406,20 +406,20 @@
(pffi-define-library libc-stdlib (pffi-define-library libc-stdlib
(list "stdlib.h") (list "stdlib.h")
(cond-expand (windows "ucrtbase") (else "c")) (cond-expand (windows "ucrtbase") (else "c"))
'(additional-versions . ("0" "6"))) '((additional-versions . ("0" "6"))))
(debug libc-stdlib) (debug libc-stdlib)
(pffi-define-library libc-stdio (pffi-define-library libc-stdio
(list "stdio.h") (list "stdio.h")
(cond-expand (windows "ucrtbase") (else "c")) (cond-expand (windows "ucrtbase") (else "c"))
'(additional-versions . ("0" "6"))) '((additional-versions . ("0" "6"))))
(debug libc-stdio) (debug libc-stdio)
(pffi-define-library c-testlib (pffi-define-library c-testlib
(list "libtest.h") (list "libtest.h")
"test" "test"
'(additional-paths . ("."))) '((additional-paths . ("."))))
(debug c-testlib) (debug c-testlib)