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

- Added versions to auto-load 

- Fixed some bugs in chicken pffi-pointer-null?
- Moved some tests to that test-all.sh now tests only supported implementations
This commit is contained in:
retropikzel 2024-05-24 08:30:24 +03:00
parent 888a66eaee
commit e32a2f2194
16 changed files with 92 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
README.md
View File

@ -20,7 +20,6 @@ Pull requests to fix bugs and add more tests are welcome.
- Compiling of C code at any point
- That is no stubs, no C code generated by the library and so on
For bugs you can use the
[Bugs](https://codeberg.org/r7rs-pffi/pffi/projects/9101)
@ -99,10 +98,18 @@ Types are given as symbols, for example 'int8 or 'pointer.
Arguments:
- headers (list (string) ...)
- C headers of the library
- For example (list "curl/curl.h")
- object-name (symbol)
- The name of the dynamic library file you want to load without the "lib" in fron of it or .so/.dll at the end
- The name of the dynamic library file you want to load
- Without the "lib" in front of it
- Without the ".so" or ".dll" at the end
- addition-versions (list (string)...)
- For example (list ".0" ".1")
- addition-paths (list (string)...)
- Any additional paths you want to search for the library
- For example (list "./mylibs")
Returns:

4
guix-chicken-init.sh
View File

@ -1,7 +1,7 @@
#!/usr/bin/env bash
export CHICKEN_INSTALL_REPOSITORY=${HOME}/eggs/lib/chicken/5
export CHICKEN_REPOSITORY_PATH=${CHICKEN_REPOSITORY_PATH}:${HOME}/eggs/lib/chicken/5
export CHICKEN_REPOSITORY_PATH=${CHICKEN_REPOSITORY_PATH}:${HOME}/.local/share/eggs/lib/chicken/5
chicken-install -init ${HOME}/eggs/lib/chicken/5
#chicken-install -init ${HOME}/eggs/lib/chicken/5
chicken-install r7rs

0
test-stklos.sh → in-progress-stklos.sh
View File

0
test-cyclone.sh → in-progress-test-cyclone.sh
View File

0
test-gambit.sh → in-progress-test-gambit.sh
View File

0
test-gerbil.sh → in-progress-test-gerbil.sh
View File

3
retropikzel/pffi/v0-1-0/chicken.scm
View File

@ -159,7 +159,8 @@
(define pffi-pointer-null?
(lambda (pointer)
(= (pointer->address pointer) 0)))
(and (pffi-pointer? pointer)
(= (pointer->address pointer) 0))))
(define pffi-pointer-set!
(lambda (pointer type offset value)

1
retropikzel/pffi/v0-1-0/kawa.scm
View File

@ -67,6 +67,7 @@
(symbol->string c-name))
'orElseThrow)
function-descriptor)))
(lambda vals
(invoke method-handle 'invokeWithArguments (map value->object vals argument-types))))))))

40
retropikzel/pffi/v0-1-0/main.scm
View File

@ -79,6 +79,7 @@
(begin
(define library-version "v0-1-0")
(define slash (cond-expand (windows (string #\\)) (else "/")))
(define platform-file-extension
(cond-expand
@ -86,12 +87,6 @@
(windows ".dll")
(else ".so")))
(define platform-version-file-extension
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so.0"))
(windows ".dll")
(else ".so.0")))
(define platform-lib-prefix
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
@ -166,7 +161,9 @@
"/usr/lib/x86_64-linux-gnu"
"/usr/local/lib"))))))
(define-syntax pffi-shared-object-auto-load
(define auto-load-versions (list ""))
(define-syntax pffi-shared-object-auto-load-old
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name additional-paths)
(cond-expand
@ -215,6 +212,35 @@
(error "Could not load shared object" object-name)
shared-object)))))))
(define-syntax pffi-shared-object-auto-load
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name additional-versions additional-paths)
(cond-expand
(cyclone (pffi-shared-object-load headers))
(chicken (pffi-shared-object-load headers))
(gambit (pffi-shared-object-load headers))
(else
(let* ((paths (append auto-load-paths additional-paths))
(versions (append auto-load-versions additional-versions))
(shared-object #f))
(for-each
(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" object-name)
(pffi-shared-object-load headers shared-object))))))))
(cond-expand
(kawa (include "kawa.scm"))
(else #t))))

40
retropikzel/pffi/v0-1-0/main.sld
View File

@ -79,6 +79,7 @@
(begin
(define library-version "v0-1-0")
(define slash (cond-expand (windows (string #\\)) (else "/")))
(define platform-file-extension
(cond-expand
@ -86,12 +87,6 @@
(windows ".dll")
(else ".so")))
(define platform-version-file-extension
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so.0"))
(windows ".dll")
(else ".so.0")))
(define platform-lib-prefix
(cond-expand
(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
@ -166,7 +161,9 @@
"/usr/lib/x86_64-linux-gnu"
"/usr/local/lib"))))))
(define-syntax pffi-shared-object-auto-load
(define auto-load-versions (list ""))
(define-syntax pffi-shared-object-auto-load-old
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name additional-paths)
(cond-expand
@ -215,6 +212,35 @@
(error "Could not load shared object" object-name)
shared-object)))))))
(define-syntax pffi-shared-object-auto-load
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name additional-versions additional-paths)
(cond-expand
(cyclone (pffi-shared-object-load headers))
(chicken (pffi-shared-object-load headers))
(gambit (pffi-shared-object-load headers))
(else
(let* ((paths (append auto-load-paths additional-paths))
(versions (append auto-load-versions additional-versions))
(shared-object #f))
(for-each
(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" object-name)
(pffi-shared-object-load headers shared-object))))))))
(cond-expand
(kawa (include "kawa.scm"))
(else #t))))

2
scripts/init-test.sh
View File

@ -1,5 +1,7 @@
set -eu
set -o pipefail
make clean
make build
make tmp

4
scripts/test-runs-compilers.sh
View File

@ -1,7 +1,9 @@
for file in ./test/*.scm
do
echo "Testing ${file}"
echo "==========================================================="
echo "Testing ${file}, with ${SCHEME}"
echo "==========================================================="
${SCHEME} ${file}
${file//.scm/}
done

4
scripts/test-runs-dynamic.sh
View File

@ -1,6 +1,8 @@
for file in ./test/*.scm
do
echo "Testing ${file}"
echo "==========================================================="
echo "Testing ${file}, with ${SCHEME}"
echo "==========================================================="
${SCHEME} ${file}
done

1
test-all.sh
View File

@ -1,6 +1,5 @@
#!/usr/bin/env bash
for testfile in ./test-*.sh
do
if [[ ! "${testfile}" = "./test-all.sh" ]];

5
test/600_pffi-define.scm
View File

@ -4,7 +4,10 @@
(scheme eval)
(retropikzel pffi v0-1-0 main))
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") "curl" (list)))
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h")
"curl"
(list ".4")
(list)))
(pffi-define curl-version libcurl 'curl_version 'string (list))

17
test/600_string-to_pointer_to_string.scm
View File

@ -1,17 +0,0 @@
(import (scheme base)
(scheme write)
(retropikzel pffi v0-1-0 main))
(define original "Hello world")
(define p (pffi-string->pointer original))
(write p)
(newline)
(define s (pffi-pointer->string p))
(if (not (string=? original s))
(error (string-append "string from pointer is not " original) s))
(write s)
(newline)