From c487f7a1b1de83d00d48dcc730916d9c99b0ddd6 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 13 May 2025 20:41:36 +0300 Subject: [PATCH] Change to renamed stklos pointer primitives --- Makefile | 57 +++++++++++++------------- foreign/c.sld | 72 ++++++++++++++++----------------- foreign/c/primitives/stklos.scm | 12 +++--- 3 files changed, 70 insertions(+), 71 deletions(-) diff --git a/Makefile b/Makefile index 232a1a4..608ec21 100644 --- a/Makefile +++ b/Makefile @@ -4,6 +4,35 @@ DOCKER=docker run -it -v ${PWD}:/workdir DOCKER_INIT=cd /workdir && make clean && VERSION=$(shell grep "version:" README.md | awk '{split\($0,a\); print a[2];}') +test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a + make ${COMPILE_R7RS} + cp -r foreign tmp/test/ + cp tests/*.scm tmp/test/ + cp tests/c-include/libtest.h tmp/test/ + cd tmp/test && \ + COMPILE_R7RS_GAMBIT="-cc-options \"-ltest -I. -L\" -ld-options \"-L.\"" \ + COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." \ + compile-r7rs -I . -o ${TESTNAME} ${TESTNAME}.scm + cd tmp/test && \ + LD_LIBRARY_PATH=. \ + ./${TESTNAME} + +test-compile-r7rs-docker: + docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f dockerfiles/test . + docker run -v "${PWD}":/workdir -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} test-compile-r7rs" + +tmp/test/libtest.o: tests/c-src/libtest.c + mkdir -p tmp/test + ${CC} -o tmp/test/libtest.o -fPIC -c tests/c-src/libtest.c -I./include + +tmp/test/libtest.so: tests/c-src/libtest.c + mkdir -p tmp/test + ${CC} -o tmp/test/libtest.so -shared -fPIC tests/c-src/libtest.c -I./include + +tmp/test/libtest.a: tmp/test/libtest.o tests/c-src/libtest.c + ar rcs tmp/test/libtest.a tmp/test/libtest.o + + # apt-get install pandoc weasyprint docs: mkdir -p documentation @@ -64,34 +93,6 @@ tr7: ypsilon: make -C foreign/c tr7 -test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a - make ${COMPILE_R7RS} - cp -r foreign tmp/test/ - cp tests/*.scm tmp/test/ - cp tests/c-include/libtest.h tmp/test/ - cd tmp/test && \ - COMPILE_R7RS_GAMBIT="-cc-options \"-ltest -I. -L\" -ld-options \"-L.\"" \ - COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." \ - compile-r7rs -I . -o ${TESTNAME} ${TESTNAME}.scm - cd tmp/test && \ - LD_LIBRARY_PATH=. \ - ./${TESTNAME} - -test-compile-r7rs-docker: - docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f dockerfiles/test . - docker run -v "${PWD}":/workdir -w /workdir -t r7rs-pffi-test-${COMPILE_R7RS} sh -c "make COMPILE_R7RS=${COMPILE_R7RS} test-compile-r7rs" - -tmp/test/libtest.o: tests/c-src/libtest.c - mkdir -p tmp/test - ${CC} -o tmp/test/libtest.o -fPIC -c tests/c-src/libtest.c -I./include - -tmp/test/libtest.so: tests/c-src/libtest.c - mkdir -p tmp/test - ${CC} -o tmp/test/libtest.so -shared -fPIC tests/c-src/libtest.c -I./include - -tmp/test/libtest.a: tmp/test/libtest.o tests/c-src/libtest.c - ar rcs tmp/test/libtest.a tmp/test/libtest.o - clean: find . -name "*.meta" -delete find . -name "*.link" -delete diff --git a/foreign/c.sld b/foreign/c.sld index 9b1cd9d..7ae354d 100644 --- a/foreign/c.sld +++ b/foreign/c.sld @@ -145,42 +145,42 @@ cpointer-data-set! ;c-bytevector-s8-set! ;c-bytevector-s8-set! - pointer-set-c-int8_t! - pointer-ref-c-int8_t - pointer-set-c-uint8_t! - pointer-ref-c-uint8_t - pointer-set-c-int16_t! - pointer-ref-c-int16_t - pointer-set-c-uint16_t! - pointer-ref-c-uint16_t - pointer-set-c-int32_t! - pointer-ref-c-int32_t - pointer-set-c-uint32_t! - pointer-ref-c-uint32_t - pointer-set-c-int64_t! - pointer-ref-c-int64_t - pointer-set-c-uint64_t! - pointer-ref-c-uint64_t - pointer-set-c-char! - pointer-ref-c-char - pointer-set-c-short! - pointer-ref-c-short - pointer-set-c-unsigned-short! - pointer-ref-c-unsigned-short - pointer-set-c-int! - pointer-ref-c-int - pointer-set-c-unsigned-int! - pointer-ref-c-unsigned-int - pointer-set-c-long! - pointer-ref-c-long - pointer-set-c-unsigned-long! - pointer-ref-c-unsigned-long - pointer-set-c-float! - pointer-ref-c-float - pointer-set-c-double! - pointer-ref-c-double - pointer-set-c-pointer! - pointer-ref-c-pointer + cpointer-set-int8_t! + cpointer-ref-int8_t + cpointer-set-uint8_t! + cpointer-ref-uint8_t + cpointer-set-int16_t! + cpointer-ref-int16_t + cpointer-set-uint16_t! + cpointer-ref-uint16_t + cpointer-set-int32_t! + cpointer-ref-int32_t + cpointer-set-uint32_t! + cpointer-ref-uint32_t + cpointer-set-int64_t! + cpointer-ref-int64_t + cpointer-set-uint64_t! + cpointer-ref-uint64_t + cpointer-set-char! + cpointer-ref-char + cpointer-set-short! + cpointer-ref-short + cpointer-set-unsigned-short! + cpointer-ref-unsigned-short + cpointer-set-int! + cpointer-ref-int + cpointer-set-unsigned-int! + cpointer-ref-unsigned-int + cpointer-set-long! + cpointer-ref-long + cpointer-set-unsigned-long! + cpointer-ref-unsigned-long + cpointer-set-float! + cpointer-ref-float + cpointer-set-double! + cpointer-ref-double + cpointer-set-pointer! + cpointer-ref-pointer void?)) (export ; calculate-struct-size-and-offsets ;struct-make diff --git a/foreign/c/primitives/stklos.scm b/foreign/c/primitives/stklos.scm index 6037a3b..4544245 100644 --- a/foreign/c/primitives/stklos.scm +++ b/foreign/c/primitives/stklos.scm @@ -68,9 +68,7 @@ (define scheme-name (%make-callback procedure (map type->native-type argument-types) - (type->native-type return-type)) - - )))) + (type->native-type return-type)))))) ; FIXME (define size-of-type @@ -95,10 +93,10 @@ ((equal? type 'double) 8) ((equal? type 'pointer) 8)))) -(define c-bytevector-u8-set! pointer-set-c-uint8_t!) -(define c-bytevector-u8-ref pointer-ref-c-uint8_t) -(define c-bytevector-pointer-set! pointer-set-c-pointer!) -(define c-bytevector-pointer-ref pointer-ref-c-pointer) +(define c-bytevector-u8-set! cpointer-set-uint8_t!) +(define c-bytevector-u8-ref cpointer-ref-uint8_t) +(define c-bytevector-pointer-set! cpointer-set-pointer!) +(define c-bytevector-pointer-ref cpointer-ref-pointer) #;(define pffi-pointer-set! (lambda (pointer type offset value)