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

Change to renamed stklos pointer primitives

This commit is contained in:
retropikzel 2025-05-13 20:41:36 +03:00
parent 924dc895e0
commit c487f7a1b1
3 changed files with 70 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
Makefile
View File

@ -4,6 +4,35 @@ DOCKER=docker run -it -v ${PWD}:/workdir
DOCKER_INIT=cd /workdir && make clean && DOCKER_INIT=cd /workdir && make clean &&
VERSION=$(shell grep "version:" README.md | awk '{split\($0,a\); print a[2];}') 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 # apt-get install pandoc weasyprint
docs: docs:
mkdir -p documentation mkdir -p documentation
@ -64,34 +93,6 @@ tr7:
ypsilon: ypsilon:
make -C foreign/c tr7 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: clean:
find . -name "*.meta" -delete find . -name "*.meta" -delete
find . -name "*.link" -delete find . -name "*.link" -delete

72
foreign/c.sld
View File

@ -145,42 +145,42 @@
cpointer-data-set! cpointer-data-set!
;c-bytevector-s8-set! ;c-bytevector-s8-set!
;c-bytevector-s8-set! ;c-bytevector-s8-set!
pointer-set-c-int8_t! cpointer-set-int8_t!
pointer-ref-c-int8_t cpointer-ref-int8_t
pointer-set-c-uint8_t! cpointer-set-uint8_t!
pointer-ref-c-uint8_t cpointer-ref-uint8_t
pointer-set-c-int16_t! cpointer-set-int16_t!
pointer-ref-c-int16_t cpointer-ref-int16_t
pointer-set-c-uint16_t! cpointer-set-uint16_t!
pointer-ref-c-uint16_t cpointer-ref-uint16_t
pointer-set-c-int32_t! cpointer-set-int32_t!
pointer-ref-c-int32_t cpointer-ref-int32_t
pointer-set-c-uint32_t! cpointer-set-uint32_t!
pointer-ref-c-uint32_t cpointer-ref-uint32_t
pointer-set-c-int64_t! cpointer-set-int64_t!
pointer-ref-c-int64_t cpointer-ref-int64_t
pointer-set-c-uint64_t! cpointer-set-uint64_t!
pointer-ref-c-uint64_t cpointer-ref-uint64_t
pointer-set-c-char! cpointer-set-char!
pointer-ref-c-char cpointer-ref-char
pointer-set-c-short! cpointer-set-short!
pointer-ref-c-short cpointer-ref-short
pointer-set-c-unsigned-short! cpointer-set-unsigned-short!
pointer-ref-c-unsigned-short cpointer-ref-unsigned-short
pointer-set-c-int! cpointer-set-int!
pointer-ref-c-int cpointer-ref-int
pointer-set-c-unsigned-int! cpointer-set-unsigned-int!
pointer-ref-c-unsigned-int cpointer-ref-unsigned-int
pointer-set-c-long! cpointer-set-long!
pointer-ref-c-long cpointer-ref-long
pointer-set-c-unsigned-long! cpointer-set-unsigned-long!
pointer-ref-c-unsigned-long cpointer-ref-unsigned-long
pointer-set-c-float! cpointer-set-float!
pointer-ref-c-float cpointer-ref-float
pointer-set-c-double! cpointer-set-double!
pointer-ref-c-double cpointer-ref-double
pointer-set-c-pointer! cpointer-set-pointer!
pointer-ref-c-pointer cpointer-ref-pointer
void?)) void?))
(export ; calculate-struct-size-and-offsets (export ; calculate-struct-size-and-offsets
;struct-make ;struct-make

12
foreign/c/primitives/stklos.scm
View File

@ -68,9 +68,7 @@
(define scheme-name (define scheme-name
(%make-callback procedure (%make-callback procedure
(map type->native-type argument-types) (map type->native-type argument-types)
(type->native-type return-type)) (type->native-type return-type))))))
))))
; FIXME ; FIXME
(define size-of-type (define size-of-type
@ -95,10 +93,10 @@
((equal? type 'double) 8) ((equal? type 'double) 8)
((equal? type 'pointer) 8)))) ((equal? type 'pointer) 8))))
(define c-bytevector-u8-set! pointer-set-c-uint8_t!) (define c-bytevector-u8-set! cpointer-set-uint8_t!)
(define c-bytevector-u8-ref pointer-ref-c-uint8_t) (define c-bytevector-u8-ref cpointer-ref-uint8_t)
(define c-bytevector-pointer-set! pointer-set-c-pointer!) (define c-bytevector-pointer-set! cpointer-set-pointer!)
(define c-bytevector-pointer-ref pointer-ref-c-pointer) (define c-bytevector-pointer-ref cpointer-ref-pointer)
#;(define pffi-pointer-set! #;(define pffi-pointer-set!
(lambda (pointer type offset value) (lambda (pointer type offset value)