Update the implementation table

This commit is contained in:
retropikzel 2025-02-06 17:02:09 +02:00
parent 924e60dcb7
commit 14ba1dd3fb
6 changed files with 122 additions and 74 deletions

View File

@ -32,39 +32,30 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.
test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
${CHIBI} test.scm ${CHIBI} test.scm
CHICKEN5=SCMC=csc CSCFLAGS='-I. -L. -L -ltest' compile-r7rs -I . main.scm CHICKEN5=SCMC=csc CSC_FLAGS='-I. -L. -L -ltest' compile-r7rs -I . main.scm
#CHICKEN5=csc -X r7rs -R r7rs -uses scheme.base -I. test-chicken-5-podman-amd65: clean libtest.a
#CHICKEN5_LIB=csc -X r7rs -R r7rs -uses r7rs -I. -include-path ./retropikzel -s -J
#CHICKEN5_LIB=csc -X r7rs -R r7rs -uses r7rs -unit retropikzel.r7rs-pffi -include-path ./retropikzel -s -J
test-chicken5-podman-amd65: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test" podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5-docker: clean libtest.a test-chicken-5-docker: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
${DOCKER} schemers/chicken:5 bash -c "${DOCKER_INIT} && cd /workdir && ${CHICKEN5} test.scm && ./test" ${DOCKER} schemers/chicken:5 bash -c "${DOCKER_INIT} && cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5: clean libtest.a test-chicken-5: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld
${CHICKEN5} test.scm ${CHICKEN5} test.scm
./test ./test
CHICKEN6=csc -I. CHICKEN6=csc -I.
CHICKEN6_LIB=csc -I. -include-path ./retropikzel -s -J CHICKEN6_LIB=csc -I. -include-path ./retropikzel -s -J
test-chicken6-podman-amd65: clean libtest.so test-chicken-6-podman-amd65: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld" podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test" podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken6-docker: clean libtest.so test-chicken-6-docker: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld" docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test" docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken6: clean libtest.so test-chicken-6: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
${CHICKEN6_LIB} retropikzel.r7rs-pffi.sld ${CHICKEN6_LIB} retropikzel.r7rs-pffi.sld
${CHICKEN6} test.scm && ./test ${CHICKEN6} test.scm && ./test

View File

@ -68,56 +68,33 @@ guarantees are being made just yet.
Due to supporting many different Scheme implementations, different parts of this software are in Due to supporting many different Scheme implementations, different parts of this software are in
different stage. As a whole it is still in **alpha** stage. That said the interface should not be different stage. As a whole it is still in **alpha** stage. That said the interface should not be
changing anymore and support for some implementations are in **beta**. changing anymore and some implementations are in **beta**.
## Implementation status
### Alpha
Anything not in beta or done, not recommended to use.
### Beta
Usage can be started but might still be quite buggy.
- Guile
- Sagittarius
- Racket
### Done
Usage recommended.
- None yet
## Implementation table ## Implementation table
| | Chibi | Chicken 5 | Cyclone | Gambit | Gauche | Gerbil | Guile | Kawa | Larceny | Mosh | Racket | Sagittarius | Skint | STklos | tr7 | Ypsilon | ### Beta
| ------------------------------- | ----- | --------- | ------- | ------- | ------ | ------ | ----- | ---- | ------- | ---- | ------ | ----------- | ----- | ------ | --- | ------- |
| 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-struct-make | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-size | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-pointer | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-offset-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-set! | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-dereference | | X | | | | | X | | | X | X | X | | | | |
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |
## Other implementations | | 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 |
### Alpha
| 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
- [LIPS](https://lips.js.org/) - [LIPS](https://lips.js.org/)
- Will work on nodejs by using some C FFI library from npm - Will work on nodejs by using some C FFI library from npm
@ -127,8 +104,6 @@ Usage recommended.
- Javascript side needs design - Javascript side needs design
- [MIT-Scheme](https://www.gnu.org/software/mit-scheme/) - [MIT-Scheme](https://www.gnu.org/software/mit-scheme/)
- Need to study the implementation more - Need to study the implementation more
- [s7](https://scheme.fail://ccrma.stanford.edu/software/snd/snd/s7.html)
- Propably does not need FFI?
- [Airship](https://gitlab.com/mbabich/airship-scheme) - [Airship](https://gitlab.com/mbabich/airship-scheme)
- Need to study the implementation more - Need to study the implementation more
- [Other gambit targets](https://gambitscheme.org/) - [Other gambit targets](https://gambitscheme.org/)
@ -139,6 +114,11 @@ Usage recommended.
- Need to study the implementation more - Need to study the implementation more
- [prescheme](https://codeberg.org/prescheme/prescheme) - [prescheme](https://codeberg.org/prescheme/prescheme)
- Need to study the implementation more - Need to study the implementation more
### Other
- [s7](https://scheme.fail://ccrma.stanford.edu/software/snd/snd/s7.html)
- Propably does not need FFI as it is embeddable only
- [Loko](https://scheme.fail/) - [Loko](https://scheme.fail/)
- Desires no C interop, I can respect that - Desires no C interop, I can respect that
@ -297,12 +277,15 @@ Makes pointer out of a given string.
Makes string out of a given pointer. Makes string out of a given pointer.
##### **pffi-struct-make** name members . pointer -> pffi-struct ##### **pffi-struct-make** c-type members . pointer -> pffi-struct
Creates a new pffi-struct and allocates pointer for it. The members argument is a list of member Creates a new pffi-struct and allocates pointer for it. The members argument is a list of member
names and types. For example: names and types. For example:
(define s (pffi-struct-make 'test '((int . r) (int . g) (int . b)))) (define color (pffi-struct-make 'color '((int8 . r) (int8 . g) (int8 . b) (int8 .a ))))
(define test (pffi-struct-make "struct test" '((int8 . r) (int8 . g) (int8 . b) (int8 .a ))))
C-type argument can be symbol or a string.
##### **pffi-struct-size** pffi-struct -> number ##### **pffi-struct-size** pffi-struct -> number

View File

@ -182,6 +182,38 @@ EXPORT int test_check(struct test* test) {
assert(test->n == 14); assert(test->n == 14);
} }
EXPORT int test_check_by_value(struct test test) {
print_offsets();
printf("C: Value of a is %c\n", test.a);
assert(test.a == 1);
printf("C: Value of b is %c\n", test.b);
assert(test.b == 'b');
printf("C: Value of c is %lf\n", test.c);
assert(test.c == 3.0);
printf("C: Value of d is %c\n", test.d);
assert(test.d == 'd');
printf("C: Value of e is %s\n", test.e);
assert(test.e == NULL);
printf("C: Value of f is %f\n", test.f);
assert(test.f == 6.0);
printf("C: Value of g is %f\n", test.g);
assert(strcmp(test.g, "foo") == 0);
printf("C: Value of g is %i\n", test.h);
assert(test.h == 8);
printf("C: Value of i is %s\n", test.i);
assert(test.i == NULL);
printf("C: Value of j is %i\n", test.j);
assert(test.j == 10);
printf("C: Value of k is %i\n", test.k);
assert(test.k == 11);
printf("C: Value of l is %i\n", test.l);
assert(test.l == 12);
printf("C: Value of m is %i\n", test.m);
assert(test.m == 13);
printf("C: Value of n is %i\n", test.n);
assert(test.n == 14);
}
EXPORT struct test* test_new() { EXPORT struct test* test_new() {
print_offsets(); print_offsets();
struct test* t = malloc(sizeof(struct test)); struct test* t = malloc(sizeof(struct test));

View File

@ -3,4 +3,5 @@ void print_offsets();
void check_offset(int member_index, int offset); void check_offset(int member_index, int offset);
struct test* init_struct(struct test* test); struct test* init_struct(struct test* test);
int test_check(struct test* test); int test_check(struct test* test);
int test_check_by_value(struct test test);
struct test* test_new(); struct test* test_new();

View File

@ -1,8 +1,8 @@
(define-record-type <pffi-struct> (define-record-type <pffi-struct>
(struct-make name size pointer members) (struct-make c-type size pointer members)
pffi-struct? pffi-struct?
(name pffi-struct-name) (c-type pffi-struct-c-type)
(size pffi-struct-size) (size pffi-struct-size)
(pointer pffi-struct-pointer) (pointer pffi-struct-pointer)
(members pffi-struct-members)) (members pffi-struct-members))
@ -48,22 +48,22 @@
(cons 'offsets offsets)))) (cons 'offsets offsets))))
(define pffi-struct-make (define pffi-struct-make
(lambda (name members . pointer) (lambda (c-type members . pointer)
(for-each (for-each
(lambda (member) (lambda (member)
(when (not (pair? member)) (when (not (pair? member))
(error "All struct members must be pairs" (list name member))) (error "All struct members must be pairs" (list c-type member)))
(when (not (symbol? (car member))) (when (not (symbol? (car member)))
(error "All struct member types must be symbols" (list name member))) (error "All struct member types must be symbols" (list c-type member)))
(when (not (symbol? (cdr member))) (when (not (symbol? (cdr member)))
(error "All struct member names must be symbols" (list name member)))) (error "All struct member names must be symbols" (list c-type member))))
members) members)
(let* ((size-and-offsets (calculate-struct-size-and-offsets members)) (let* ((size-and-offsets (calculate-struct-size-and-offsets members))
(size (cdr (assoc 'size size-and-offsets))) (size (cdr (assoc 'size size-and-offsets)))
(offsets (cdr (assoc 'offsets size-and-offsets))) (offsets (cdr (assoc 'offsets size-and-offsets)))
(pointer (if (null? pointer) (pffi-pointer-allocate size) (car pointer))) (pointer (if (null? pointer) (pffi-pointer-allocate size) (car pointer)))
(name (if (string? name) name (symbol->string name)))) (c-typr (if (string? c-type) c-type (symbol->string c-type))))
(struct-make name size pointer offsets)))) (struct-make c-type size pointer offsets))))
(define (pffi-struct-offset-get struct member-name) (define (pffi-struct-offset-get struct member-name)
(when (not (assoc member-name (pffi-struct-members struct))) (when (not (assoc member-name (pffi-struct-members struct)))

View File

@ -781,4 +781,45 @@
(debug sorted) (debug sorted)
(assert equal? sorted (list 1 2 3)) (assert equal? sorted (list 1 2 3))
;; pffi-struct-dereference
(print-header 'pffi-struct-dereference)
;; pffi-struct-set!
(print-header 'pffi-struct-set!)
(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int (list 'struct))
(define struct-test3 (pffi-struct-make 'test
'((int8 . a)
(char . b)
(double . c)
(char . d)
(pointer . e)
(float . f)
(pointer . g)
(int8 . h)
(pointer . i)
(int . j)
(int . k)
(int . l)
(double . m)
(float . n))))
(pffi-struct-set! struct-test3 'a 1)
(pffi-struct-set! struct-test3 'b #\b)
(pffi-struct-set! struct-test3 'c 3.0)
(pffi-struct-set! struct-test3 'd #\d)
(pffi-struct-set! struct-test3 'e (pffi-pointer-null))
(pffi-struct-set! struct-test3 'f 6.0)
(pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo"))
(pffi-struct-set! struct-test3 'h 8)
(pffi-struct-set! struct-test3 'i (pffi-pointer-null))
(pffi-struct-set! struct-test3 'j 10)
(pffi-struct-set! struct-test3 'k 11)
(pffi-struct-set! struct-test3 'l 12)
(pffi-struct-set! struct-test3 'm 13.0)
(pffi-struct-set! struct-test3 'n 14.0)
(c-test-check-by-value (pffi-struct-dereference struct-test3))
(exit 0) (exit 0)