From 4c891537909dcdde8e34b2bd862c8fe0e77e9a4d Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 8 Jul 2025 08:28:41 +0300 Subject: [PATCH] Fix segfault on chibi scheme when passing null pointers --- Makefile | 16 ++++++++-------- foreign/c/primitives/chibi.scm | 6 ++++++ foreign/c/primitives/chibi/foreign-c.stub | 5 ++++- tests/pointers.scm | 8 +++----- 4 files changed, 21 insertions(+), 14 deletions(-) diff --git a/Makefile b/Makefile index 73e187a..9d10216 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ CC=gcc DOCKER=docker run -it -v ${PWD}:/workdir DOCKER_INIT=cd /workdir && make clean && VERSION=$(shell awk '/version:/{ print $$2 }' README.md ) -TESTNAME=primitives +TEST=primitives SCHEME=chibi all: package @@ -31,9 +31,9 @@ test-java: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a cp tests/*.scm tmp/test/ cp tests/c-include/libtest.h tmp/test/ cd tmp/test \ - && ${JAVA_HOME}/bin/java --add-exports java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar kawa.jar --r7rs --full-tailcalls -Dkawa.import.path=*.sld:./snow/*.sld:./snow/retropikzel/*.sld ${TESTNAME}.scm + && ${JAVA_HOME}/bin/java --add-exports java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar kawa.jar --r7rs --full-tailcalls -Dkawa.import.path=*.sld:./snow/*.sld:./snow/retropikzel/*.sld ${TEST}.scm -test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a +test: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a make ${SCHEME} cp -r foreign tmp/test/ cp tests/*.scm tmp/test/ @@ -42,8 +42,8 @@ test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." \ COMPILE_R7RS_KAWA="-J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -J--enable-preview" \ COMPILE_R7RS=${SCHEME} \ - compile-r7rs -I . -o ${TESTNAME} ${TESTNAME}.scm - cd tmp/test && ./${TESTNAME} + compile-r7rs -I . -o ${TEST} ${TEST}.scm + cd tmp/test && ./${TEST} test-compile-r7rs-snow: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a cp tests/*.scm tmp/test/ @@ -57,14 +57,14 @@ test-compile-r7rs-wine: cp tests/*.scm tmp/test/ cp tests/c-include/libtest.h tmp/test/ cd tmp/test && \ - wine "${HOME}/.wine/drive_c/Program Files (x86)/compile-r7rs/compile-r7rs.bat" -I . -o ${TESTNAME} ${TESTNAME}.scm + wine "${HOME}/.wine/drive_c/Program Files (x86)/compile-r7rs/compile-r7rs.bat" -I . -o ${TEST} ${TEST}.scm cd tmp/test && \ LD_LIBRARY_PATH=. \ - wine ./${TESTNAME}.bat + wine ./${TEST}.bat test-compile-r7rs-docker: docker build --build-arg COMPILE_R7RS=${SCHEME} --tag=r7rs-pffi-test-${SCHEME} -f dockerfiles/Dockerfile.test . - docker run -it -v "${PWD}:/workdir" -w /workdir -t r7rs-pffi-test-${SCHEME} sh -c "make COMPILE_R7RS=${SCHEME} TESTNAME=${TESTNAME} test-compile-r7rs" + docker run -it -v "${PWD}:/workdir" -w /workdir -t r7rs-pffi-test-${SCHEME} sh -c "make COMPILE_R7RS=${SCHEME} TEST=${TEST} test-compile-r7rs" tmp/test/libtest.o: tests/c-src/libtest.c mkdir -p tmp/test diff --git a/foreign/c/primitives/chibi.scm b/foreign/c/primitives/chibi.scm index d6fed7c..e9ffc95 100644 --- a/foreign/c/primitives/chibi.scm +++ b/foreign/c/primitives/chibi.scm @@ -69,6 +69,12 @@ (let ((c-function (dlsym shared-object c-name)) (maybe-dlerror (dlerror))) (lambda arguments + (display "NAME: ") + (display c-name) + (newline) + (display "ARGS: ") + (write arguments) + (newline) (let* ((return-pointer (internal-ffi-call (length argument-types) (type->libffi-type-number return-type) diff --git a/foreign/c/primitives/chibi/foreign-c.stub b/foreign/c/primitives/chibi/foreign-c.stub index ae47bbe..c332acc 100644 --- a/foreign/c/primitives/chibi/foreign-c.stub +++ b/foreign/c/primitives/chibi/foreign-c.stub @@ -109,7 +109,9 @@ double vals18[nargs]; void* vals20[nargs]; + printf(\"nargs: %i\\n\", nargs); for(int i = 0; i < nargs; i++) { + printf(\"i: %i\\n\", i); void* arg = NULL; switch(atypes[i]) { case 1: @@ -202,10 +204,11 @@ case 19: c_atypes[i] = &ffi_type_void; arg = NULL; + c_avalues[i] = NULL; break; case 20: c_atypes[i] = &ffi_type_pointer; - if(avalues[i] != NULL) { + if(sexp_cpointerp(avalues[i])) { vals20[i] = sexp_cpointer_value(avalues[i]); } else { vals20[i] = NULL; diff --git a/tests/pointers.scm b/tests/pointers.scm index 91d8a80..085c11f 100644 --- a/tests/pointers.scm +++ b/tests/pointers.scm @@ -72,11 +72,6 @@ (newline))))) (define-c-library libc '("stdlib.h" "stdio.h" "time.h") libc-name '((additional-versions ("6")))) -(define-c-procedure c-fopen libc 'fopen 'pointer '(pointer pointer)) -(define-c-procedure c-fclose libc 'fclose 'int '(pointer)) -(define-c-procedure c-time libc 'time 'int '(pointer)) -(define-c-procedure c-srand libc 'srand 'void '(int)) -(define-c-procedure c-rand libc 'rand 'int '()) (print-header "pointers 1") @@ -88,7 +83,10 @@ (debug n) (assert equal? (c-bytevector? n) #t) +(define-c-procedure c-time libc 'time 'int '(pointer)) +(define-c-procedure c-srand libc 'srand 'void '(int)) (c-srand (c-time (make-c-null))) +(define-c-procedure c-rand libc 'rand 'int '()) (define random-integer (c-rand)) (assert equal? (number? random-integer) #t)