From 924e60dcb7f19ede43c138121290939876299c45 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 1 Feb 2025 09:00:16 +0200 Subject: [PATCH] Fixed chicken test running --- .gitignore | 1 + Makefile | 26 +++++++++++++++++--------- retropikzel/r7rs-pffi.sld | 1 + retropikzel/r7rs-pffi/cyclone.scm | 8 ++++---- retropikzel/r7rs-pffi/sagittarius.scm | 2 +- 5 files changed, 24 insertions(+), 14 deletions(-) diff --git a/.gitignore b/.gitignore index c331133..d0d28e1 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,7 @@ docuptmp *.log *.c !libtest.c +*.a *.so *.o *.so diff --git a/Makefile b/Makefile index 5cfdbd4..efbcf8b 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,18 @@ .PHONY=libtest.so CC=gcc DOCKER=docker run -it -v ${PWD}:/workdir +DOCKER_INIT=apt-get update \ + && apt-get install -y git make \ + && git clone https://git.sr.ht/~retropikzel/compile-r7rs \ + && cd compile-r7rs && make install libtest.so: libtest.c ${CC} -o libtest.so -shared -fPIC libtest.c +libtest.a: libtest.c + ${CC} -fPIC -c libtest.c + ar rcs libtest.a libtest.o + CHIBI=chibi-scheme -A . test-chibi-podman-amd64: libtest.so podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chibi bash -c "cd /workdir && chibi-ffi retropikzel/r7rs-pffi/r7rs-pffi-chibi.stub" @@ -24,21 +32,21 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi. test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so ${CHIBI} test.scm -CHICKEN5=SCMC=csc CSCFLAGS="-I. " compile-r7rs main.scm +CHICKEN5=SCMC=csc CSCFLAGS='-I. -L. -L -ltest' compile-r7rs -I . main.scm #CHICKEN5=csc -X r7rs -R r7rs -uses scheme.base -I. #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.so - 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" +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" -test-chicken5-docker: clean libtest.so - 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 run -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test" +test-chicken5-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" -test-chicken5: clean libtest.so +test-chicken5: clean libtest.a #cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld #${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld ${CHICKEN5} test.scm diff --git a/retropikzel/r7rs-pffi.sld b/retropikzel/r7rs-pffi.sld index 295a5c8..c04c997 100644 --- a/retropikzel/r7rs-pffi.sld +++ b/retropikzel/r7rs-pffi.sld @@ -128,6 +128,7 @@ pffi-struct-offset-get pffi-struct-get pffi-struct-set! + ;pffi-struct-dereference pffi-define ;pffi-define-callback )) diff --git a/retropikzel/r7rs-pffi/cyclone.scm b/retropikzel/r7rs-pffi/cyclone.scm index 95bda6d..b5e770d 100644 --- a/retropikzel/r7rs-pffi/cyclone.scm +++ b/retropikzel/r7rs-pffi/cyclone.scm @@ -20,6 +20,7 @@ ((equal? type 'double) double) ((equal? type 'pointer) opaque) ((equal? type 'void) c-void) + ((equal? type 'struct) 'c-pointer) (else (error "pffi-type->native-type -- No such pffi type" type))))) (define pffi-pointer? @@ -51,6 +52,7 @@ ((equal? type 'double) 'double) ((equal? type 'pointer) 'c-pointer) ((equal? type 'void) 'void) + ((equal? type 'struct) 'c-pointer) (else (error "pffi-type->native-type -- No such pffi type" type))))) (scheme-name (car (cdr expr))) (c-name (symbol->string (car (cdr (car (cdr (cdr (cdr expr)))))))) @@ -258,8 +260,7 @@ ((equal? type 'unsigned-long) (pffi-pointer-unsigned-long-set! pointer offset value)) ((equal? type 'float) (pffi-pointer-float-set! pointer offset value)) ((equal? type 'double) (pffi-pointer-double-set! pointer offset value)) - ((equal? type 'pointer) (pffi-pointer-pointer-set! pointer offset value)) - ))) + ((equal? type 'pointer) (pffi-pointer-pointer-set! pointer offset value))))) (define-c pffi-pointer-int8-get "(void *data, int argc, closure _, object k, object pointer, object offset)" @@ -373,5 +374,4 @@ ((equal? type 'unsigned-long) (pffi-pointer-unsigned-long-get pointer offset)) ((equal? type 'float) (pffi-pointer-float-get pointer offset)) ((equal? type 'double) (pffi-pointer-double-get pointer offset)) - ((equal? type 'pointer) (pffi-pointer-pointer-get pointer offset)) - ))) + ((equal? type 'pointer) (pffi-pointer-pointer-get pointer offset))))) diff --git a/retropikzel/r7rs-pffi/sagittarius.scm b/retropikzel/r7rs-pffi/sagittarius.scm index 7b2adf3..ae7ef93 100644 --- a/retropikzel/r7rs-pffi/sagittarius.scm +++ b/retropikzel/r7rs-pffi/sagittarius.scm @@ -100,7 +100,7 @@ (define pffi-pointer->string (lambda (pointer) - (pointer->string pointer))) + (pointer->string pointer))) (define pffi-shared-object-load (lambda (headers path)