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

Progress

This commit is contained in:
retropikzel 2025-03-22 14:41:28 +02:00
parent 9018ab0960
commit a0b316b47b
7 changed files with 268 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Makefile
View File

@ -1,10 +1,10 @@
.PHONY=libtest.o libtest.so libtest.a documentation .PHONY=libtest.o tests/libtest.so libtest.a documentation
CC=gcc CC=gcc
DOCKER=docker run -it -v ${PWD}:/workdir 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];}')
all: chibi gauche libtest.so libtest.o libtest.a all: chibi gauche tests/libtest.so libtest.o libtest.a
# apt-get install pandoc weasyprint # apt-get install pandoc weasyprint
docs: docs:
@ -42,27 +42,30 @@ jenkinsfile:
libtest.o: src/libtest.c libtest.o: src/libtest.c
${CC} -o libtest.o -fPIC -c src/libtest.c -I./include ${CC} -o libtest.o -fPIC -c src/libtest.c -I./include
libtest.so: src/libtest.c tests/libtest.so: src/libtest.c
${CC} -o libtest.so -shared -fPIC src/libtest.c -I./include ${CC} -o tests/libtest.so -shared -fPIC src/libtest.c -I./include
libtest.a: libtest.o src/libtest.c libtest.a: libtest.o src/libtest.c
ar rcs libtest.a libtest.o ar rcs libtest.a libtest.o
test-interpreter-compliance: libtest.so test-interpreter-compliance: tests/libtest.so
SCHEME=${SCHEME} script-r7rs -I . tests/compliance.scm SCHEME=${SCHEME} script-r7rs -I . tests/compliance.scm
test-interpreter-compliance-docker: test-interpreter-compliance-docker:
docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME} docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} script-r7rs -I . tests/compliance.scm" docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} script-r7rs -I . tests/compliance.scm"
test-compile-library: libtest.so libtest.a libtest.o test-compile-library: tests/libtest.so libtest.a libtest.o
SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld
test-compiler-compliance: test-compile-library test-compiler-compliance-compile: test-compile-library
SCHEME=${SCHEME} CFLAGS="-I./include -L." LDFLAGS="-ltest libtest.o" compile-r7rs -I . tests/compliance.scm SCHEME=${SCHEME} CFLAGS="-I../include -L.." LDFLAGS="-ltest" compile-r7rs -I . tests/compliance.scm
./tests/compliance ./tests/compliance
test-compiler-compliance-docker: libtest.so libtest.a test-compiler-compliance: test-compiler-compliance-compile
./tests/compliance
test-compiler-compliance-docker: tests/libtest.so libtest.a
docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME} docker build -f dockerfiles/test . --build-arg SCHEME=${SCHEME} --tag=pffi-${SCHEME}
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld" docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs-library retropikzel/pffi.sld"
docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs -I . compliance.scm && ./test" docker run -v ${PWD}:/workdir pffi-${SCHEME} bash -c "cd /workdir && SCHEME=${SCHEME} compile-r7rs -I . compliance.scm && ./test"

2
include/libtest.h
View File

@ -13,3 +13,5 @@ int color_check_by_value(struct color color);
int test_check(struct test* test); int test_check(struct test* test);
int test_check_by_value(struct test test); int test_check_by_value(struct test test);
struct test* test_new(); struct test* test_new();
void takes_no_args();
int takes_no_args_returns_int();

27
retropikzel/pffi.sld
View File

@ -140,23 +140,23 @@
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
pffi-load pffi-define-library
;pffi-pointer-null pffi-pointer-null
;pffi-pointer-null? pffi-pointer-null?
;pffi-pointer-allocate pffi-pointer-allocate
;pffi-pointer-address pffi-pointer-address
;pffi-pointer? pffi-pointer?
;pffi-pointer-free pffi-pointer-free
;pffi-pointer-set! pffi-pointer-set!
;pffi-pointer-get pffi-pointer-get
;pffi-string->pointer pffi-string->pointer
;pffi-pointer->string pffi-pointer->string
pffi-struct-make pffi-struct-make
pffi-struct-pointer pffi-struct-pointer
pffi-struct-offset-get pffi-struct-offset-get
pffi-struct-get pffi-struct-get
pffi-struct-set! pffi-struct-set!
;pffi-define pffi-define
;pffi-define-callback ;pffi-define-callback
)) ))
(gauche (gauche
@ -540,4 +540,5 @@
(ypsilon (include "pffi/ypsilon.scm"))) (ypsilon (include "pffi/ypsilon.scm")))
(include "pffi/shared/struct.scm") (include "pffi/shared/struct.scm")
(include "pffi/shared/union.scm") (include "pffi/shared/union.scm")
(include "pffi/shared/main.scm")) (include "pffi/shared/main.scm")
)

172
retropikzel/pffi/gambit.scm
View File

@ -1,5 +1,11 @@
(c-declare "#include <stdlib.h>")
(c-declare "#include <stdint.h>") (c-declare "#include <stdint.h>")
(define-macro
(pffi-init)
`(begin (c-define-type pointer (pointer void))
(c-define-type callback (pointer void))))
(define size-of-int8_t (c-lambda () int "___return(sizeof(int8_t));")) (define size-of-int8_t (c-lambda () int "___return(sizeof(int8_t));"))
(define size-of-uint8_t (c-lambda () int "___return(sizeof(uint8_t));")) (define size-of-uint8_t (c-lambda () int "___return(sizeof(uint8_t));"))
(define size-of-int16_t (c-lambda () int "___return(sizeof(int16_t));")) (define size-of-int16_t (c-lambda () int "___return(sizeof(int16_t));"))
@ -45,19 +51,157 @@
((eq? type 'void) (size-of-void*)) ((eq? type 'void) (size-of-void*))
(else (error "Can not get size of unknown type" type))))) (else (error "Can not get size of unknown type" type)))))
#;(define-macro (define-macro
(include-c-headers headers) (pffi-define-library name headers object-name . options)
`(c-declare ,(apply string-append `(begin (define ,name #t)
(map (c-declare ,(apply string-append
(lambda (header) (map
(string-append "#include <" header ">" (string #\newline))) (lambda (header)
(list "stdio.h"))))) (string-append "#include <" header ">" (string #\newline)))
(cdr headers))))))
(define pointer? (c-lambda ((pointer void)) bool "___return(1);"))
(define pffi-pointer?
(lambda (object)
(call-with-current-continuation
(lambda (k)
(with-exception-handler
(lambda (x) #f)
(lambda () (pointer? object)))))))
(define pffi-pointer-null (c-lambda () (pointer void) "void* p = NULL; ___return(p);"))
(define pointer-null? (c-lambda ((pointer void)) bool "if(___arg1 == NULL) { ___return(1); } else { ___return(0); }"))
(define pffi-pointer-null?
(lambda (pointer)
(and (pffi-pointer? pointer)
(pointer-null? pointer))))
(define pffi-pointer-allocate (c-lambda (int) (pointer void) "void* p = malloc(___arg1); ___return(p);"))
(define pffi-pointer-address (c-lambda ((pointer void)) ptrdiff_t "void* p = ___arg1; ___return((intptr_t)&p);"))
(define pffi-pointer-free (c-lambda ((pointer void)) void "free(___arg1);"))
(define pointer-set-c-int8_t! (c-lambda ((pointer void) int int8) void "*(int8_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-uint8_t! (c-lambda ((pointer void) int unsigned-int8) void "*(uint8_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-int16_t! (c-lambda ((pointer void) int int16) void "*(int16_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-uint16_t! (c-lambda ((pointer void) int unsigned-int16) void "*(uint16_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-int32_t! (c-lambda ((pointer void) int int32) void "*(int32_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-uint32_t! (c-lambda ((pointer void) int unsigned-int32) void "*(uint32_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-int64_t! (c-lambda ((pointer void) int int64) void "*(int64_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-uint64_t! (c-lambda ((pointer void) int unsigned-int64) void "*(uint64_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-char! (c-lambda ((pointer void) int char) void "*((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-short! (c-lambda ((pointer void) int short) void "*(short*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-unsigned-short! (c-lambda ((pointer void) int unsigned-int64) void "*(unsigned short*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-int! (c-lambda ((pointer void) int int) void "*(int*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-unsigned-int! (c-lambda ((pointer void) int unsigned-int64) void "*(unsigned int*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-long! (c-lambda ((pointer void) int long) void "*(long*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-unsigned-long! (c-lambda ((pointer void) int unsigned-int64) void "*(unsigned long*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-float! (c-lambda ((pointer void) int float) void "*(float*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-double! (c-lambda ((pointer void) int double) void "*(double*)((char*)___arg1 + ___arg2) = ___arg3;"))
(define pointer-set-c-pointer! (c-lambda ((pointer void) int (pointer void)) void "{ char* p = (char*)___arg1 + ___arg2; *(char**)p = ___arg3; }"))
(define pffi-pointer-set!
(lambda (pointer type offset value)
(cond ((equal? type 'int8) (pointer-set-c-int8_t! pointer offset value))
((equal? type 'uint8) (pointer-set-c-uint8_t! pointer offset value))
((equal? type 'int16) (pointer-set-c-int16_t! pointer offset value))
((equal? type 'uint16) (pointer-set-c-uint16_t! pointer offset value))
((equal? type 'int32) (pointer-set-c-int32_t! pointer offset value))
((equal? type 'uint32) (pointer-set-c-uint32_t! pointer offset value))
((equal? type 'int64) (pointer-set-c-int64_t! pointer offset value))
((equal? type 'uint64) (pointer-set-c-uint64_t! pointer offset value))
((equal? type 'char) (pointer-set-c-char! pointer offset value))
((equal? type 'short) (pointer-set-c-short! pointer offset value))
((equal? type 'unsigned-short) (pointer-set-c-unsigned-short! pointer offset value))
((equal? type 'int) (pointer-set-c-int! pointer offset value))
((equal? type 'unsigned-int) (pointer-set-c-unsigned-int! pointer offset value))
((equal? type 'long) (pointer-set-c-long! pointer offset value))
((equal? type 'unsigned-long) (pointer-set-c-unsigned-long! pointer offset value))
((equal? type 'float) (pointer-set-c-float! pointer offset value))
((equal? type 'double) (pointer-set-c-double! pointer offset value))
((equal? type 'void) (pointer-set-c-pointer! pointer offset value))
((equal? type 'pointer) (pointer-set-c-pointer! pointer offset value)))))
(define pointer-ref-c-int8_t (c-lambda ((pointer void) int) int8 "___return(*(int8_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-uint8_t (c-lambda ((pointer void) int) unsigned-int8 "___return(*(uint8_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-int16_t (c-lambda ((pointer void) int) int16 "___return(*(int16_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-uint16_t (c-lambda ((pointer void) int) unsigned-int16 "___return(*(uint16_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-int32_t (c-lambda ((pointer void) int) int32 "___return(*(int32_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-uint32_t (c-lambda ((pointer void) int) unsigned-int32 "___return(*(uint32_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-int64_t (c-lambda ((pointer void) int) int64 "___return(*(int64_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-uint64_t (c-lambda ((pointer void) int) unsigned-int64 "___return(*(uint64_t*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-char (c-lambda ((pointer void) int) char "___return(*((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-short (c-lambda ((pointer void) int) short "___return(*(short*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-unsigned-short (c-lambda ((pointer void) int) unsigned-short "___return(*(unsigned short*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-int (c-lambda ((pointer void) int) int "___return(*(int*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-unsigned-int (c-lambda ((pointer void) int) unsigned-int "___return(*(unsigned int*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-long (c-lambda ((pointer void) int) long "___return(*(long*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-unsigned-long (c-lambda ((pointer void) int) unsigned-long "___return(*(unsigned long*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-float (c-lambda ((pointer void) int) float "___return(*(float*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-double (c-lambda ((pointer void) int) double "___return(*(double*)((char*)___arg1 + ___arg2));"))
(define pointer-ref-c-pointer (c-lambda ((pointer void) int) (pointer void) " char* p = (char*)___arg1 + ___arg2; ___return(*(char**)p);"))
(define pffi-pointer-get
(lambda (pointer type offset)
(cond ((equal? type 'int8) (pointer-ref-c-int8_t pointer offset))
((equal? type 'uint8) (pointer-ref-c-uint8_t pointer offset))
((equal? type 'int16) (pointer-ref-c-int16_t pointer offset))
((equal? type 'uint16) (pointer-ref-c-uint16_t pointer offset))
((equal? type 'int32) (pointer-ref-c-int32_t pointer offset))
((equal? type 'uint32) (pointer-ref-c-uint32_t pointer offset))
((equal? type 'int64) (pointer-ref-c-int64_t pointer offset))
((equal? type 'uint64) (pointer-ref-c-uint64_t pointer offset))
((equal? type 'char) (pointer-ref-c-char pointer offset))
((equal? type 'short) (pointer-ref-c-short pointer offset))
((equal? type 'unsigned-short) (pointer-ref-c-unsigned-short pointer offset))
((equal? type 'int) (pointer-ref-c-int pointer offset))
((equal? type 'unsigned-int) (pointer-ref-c-unsigned-int pointer offset))
((equal? type 'long) (pointer-ref-c-long pointer offset))
((equal? type 'unsigned-long) (pointer-ref-c-unsigned-long pointer offset))
((equal? type 'float) (pointer-ref-c-float pointer offset))
((equal? type 'double) (pointer-ref-c-double pointer offset))
((equal? type 'void) (pointer-ref-c-pointer pointer offset))
((equal? type 'pointer) (pointer-ref-c-pointer pointer offset)))))
(define-macro (define-macro
(pffi-shared-object-auto-load headers object-name . options) (pffi-define scheme-name shared-object c-name return-type argument-types)
`(c-declare ,(apply string-append (display "HERE: ")
(map (write argument-types)
(lambda (header) (newline)
(string-append "#include <" header ">" (string #\newline))) (write (equal? '(list) argument-types))
(cdr headers))))) (newline)
(letrec* ((native-argument-types
(if (equal? '(list) argument-types)
(list)
(let ((types (map cdr (cdr argument-types))))
(if (null? types) types (map car types)))))
(native-return-type (car (cdr return-type)))
(c-arguments (lambda (index argument-count result)
(if (> index argument-count)
result
(c-arguments (+ index 1)
argument-count
(string-append result
"___arg"
(number->string index)
(if (< index argument-count)
", "
""))))))
(c-code (string-append
(if (equal? 'void (cadr return-type)) "" "___return(")
(symbol->string (cadr c-name))
"(" (c-arguments 1 (- (length argument-types) 1) "") ")"
(if (equal? 'void (cadr return-type)) "" ")")
";")))
(write `(define ,scheme-name
(c-lambda ,native-argument-types
,native-return-type
,c-code)))
(newline)
`(define ,scheme-name
(c-lambda ,native-argument-types
,native-return-type
,c-code))))

8
retropikzel/pffi/shared/main.scm
View File

@ -6,8 +6,8 @@
'(import (chicken foreign) '(import (chicken foreign)
(chicken memory)) (chicken memory))
#t)))) #t))))
(else (gambit #t)
(define pffi-init(lambda () #t)))) (else (define pffi-init (lambda () #t))))
(define pffi-type? (define pffi-type?
(lambda (object) (lambda (object)
@ -89,12 +89,12 @@
(cond-expand (cond-expand
(gambit #t) (gambit #t)
((or chicken cyclone) ((or chicken cyclone)
(define-syntax pffi-load (define-syntax pffi-define-library
(syntax-rules () (syntax-rules ()
((_ headers object-name . options) ((_ headers object-name . options)
(pffi-shared-object-load headers))))) (pffi-shared-object-load headers)))))
(else (else
(define pffi-load (define pffi-define-library
(lambda (headers object-name . options) (lambda (headers object-name . options)
(let* ((additional-paths (if (assoc 'additional-paths options) (let* ((additional-paths (if (assoc 'additional-paths options)
(cdr (assoc 'additional-paths options)) (cdr (assoc 'additional-paths options))

8
src/libtest.c
View File

@ -273,3 +273,11 @@ EXPORT struct test* test_new() {
t->n = 14; t->n = 14;
return t; return t;
} }
EXPORT void takes_no_args() {
puts("I take no arguments :)");
}
EXPORT int takes_no_args_returns_int() {
return 0;
}

116
tests/compliance.scm
View File

@ -28,21 +28,38 @@
(set! assert-tag tag) (set! assert-tag tag)
(set! count 0))) (set! count 0)))
(define-syntax assert (cond-expand
(syntax-rules () (gambit
((_ check value-a value-b) (define assert
(let ((result (apply check (list value-a value-b)))) (lambda (check value-a value-b)
(set! count (+ count 1)) (let ((result (apply check (list value-a value-b))))
(if (not result) (display "FAIL ") (display "PASS ")) (set! count (+ count 1))
(display "[") (if (not result) (display "FAIL ") (display "PASS "))
(display assert-tag) (display "[")
(display " - ") (display assert-tag)
(display count) (display " - ")
(display "]") (display count)
(display ": ") (display "]")
(write (list 'check 'value-a 'value-b)) (display ": ")
(newline) (write (list 'check 'value-a 'value-b))
(when (not result) (exit 1)))))) (newline)
(when (not result) (exit 1))))))
(else
(define-syntax assert
(syntax-rules ()
((_ check value-a value-b)
(let ((result (apply check (list value-a value-b))))
(set! count (+ count 1))
(if (not result) (display "FAIL ") (display "PASS "))
(display "[")
(display assert-tag)
(display " - ")
(display count)
(display "]")
(display ": ")
(write (list 'check 'value-a 'value-b))
(newline)
(when (not result) (exit 1))))))))
(define-syntax debug (define-syntax debug
(syntax-rules () (syntax-rules ()
@ -106,8 +123,6 @@
(debug (pffi-type? 'callback)) (debug (pffi-type? 'callback))
(assert equal? (pffi-type? 'callback) #t) (assert equal? (pffi-type? 'callback) #t)
(pffi-init)
;; pffi-size-of ;; pffi-size-of
(print-header 'pffi-size-of) (print-header 'pffi-size-of)
@ -384,27 +399,27 @@
(assert equal? (number? align-pointer) #t) (assert equal? (number? align-pointer) #t)
(assert = align-pointer 8))) (assert = align-pointer 8)))
;; pffi-load ;; pffi-define-library
(print-header 'pffi-load) (print-header 'pffi-define-library)
(define libc-stdlib (pffi-define-library libc-stdlib
(cond-expand (list "stdlib.h")
(windows (pffi-load (list "stdlib.h") "ucrtbase")) (cond-expand (windows "ucrtbase") (else "c"))
(else (pffi-load (list "stdlib.h") '(additional-versions . ("0" "6")))
"c"
'(additional-versions . ("0" "6"))))))
(debug libc-stdlib) (debug libc-stdlib)
(define c-testlib (pffi-define-library libc-stdio
(cond-expand (list "stdio.h")
(windows (pffi-load (list "libtest.h") (cond-expand (windows "ucrtbase") (else "c"))
"test" '(additional-versions . ("0" "6")))
'(additional-paths . (".")))) (debug libc-stdio)
(else (pffi-load (list "libtest.h")
(pffi-define-library c-testlib
(list "libtest.h")
"test" "test"
'(additional-paths . (".")))))) '(additional-paths . (".")))
(debug c-testlib) (debug c-testlib)
@ -477,12 +492,20 @@
(debug offset) (debug offset)
(debug value) (debug value)
(define-syntax test-type (cond-expand
(syntax-rules () (gambit
((_ type) (define test-type
(begin (lambda (type)
(pffi-pointer-set! set-pointer type offset value) (begin
(assert = (pffi-pointer-get set-pointer type offset) value))))) (pffi-pointer-set! set-pointer type offset value)
(assert = (pffi-pointer-get set-pointer type offset) value)))))
(else
(define-syntax test-type
(syntax-rules ()
((_ type)
(begin
(pffi-pointer-set! set-pointer type offset value)
(assert = (pffi-pointer-get set-pointer type offset) value)))))))
(test-type 'int8) (test-type 'int8)
(test-type 'uint8) (test-type 'uint8)
@ -656,14 +679,6 @@
(pffi-define c-atoi libc-stdlib 'atoi 'int (list 'pointer)) (pffi-define c-atoi libc-stdlib 'atoi 'int (list 'pointer))
(assert = (c-atoi (pffi-string->pointer "100")) 100) (assert = (c-atoi (pffi-string->pointer "100")) 100)
(define libc-stdio
(cond-expand
; FIXME Check that windows so file is correct
(windows (pffi-load (list "stdio.h") "ucrtbase"))
(else (pffi-load (list "stdio.h")
"c"
'(additional-versions . ("0" "6"))))))
(pffi-define c-fopen libc-stdio 'fopen 'pointer (list 'pointer 'pointer)) (pffi-define c-fopen libc-stdio 'fopen 'pointer (list 'pointer 'pointer))
(define output-file (c-fopen (pffi-string->pointer "testfile.test") (define output-file (c-fopen (pffi-string->pointer "testfile.test")
(pffi-string->pointer "w"))) (pffi-string->pointer "w")))
@ -682,6 +697,15 @@
(lambda () (read-line))) (lambda () (read-line)))
"Hello world") #t) "Hello world") #t)
(pffi-define c-takes-no-args c-testlib 'takes_no_args 'void (list))
(debug c-takes-no-args)
(c-takes-no-args)
(pffi-define c-takes-no-args-returns-int c-testlib 'takes_no_args_returns_int 'int (list))
(debug c-takes-no-args)
(define takes-no-args-returns-int-result (c-takes-no-args-returns-int))
(assert equal? (= takes-no-args-returns-int-result 0) #t)
;; pffi-struct-get ;; pffi-struct-get
(print-header 'pffi-struct-get) (print-header 'pffi-struct-get)