Working on Gambit implementation

This commit is contained in:
retropikzel 2025-03-21 07:16:39 +02:00
parent 1b08e57be2
commit fe5de3e731
2 changed files with 18 additions and 11 deletions

View File

@ -87,3 +87,4 @@ clean:
@rm -rf test @rm -rf test
find . -name "core.1" -delete find . -name "core.1" -delete
find . -name "*@gambit*" -delete find . -name "*@gambit*" -delete
rm -rf retropikzel/pffi.c

View File

@ -20,8 +20,7 @@
(define size-of-double (c-lambda () int "___return(sizeof(double));")) (define size-of-double (c-lambda () int "___return(sizeof(double));"))
(define size-of-void* (c-lambda () int "___return(sizeof(void*));")) (define size-of-void* (c-lambda () int "___return(sizeof(void*));"))
(define size-of-type
#;(define size-of-type
(lambda (type) (lambda (type)
(cond ((eq? type 'int8) (size-of-int8_t)) (cond ((eq? type 'int8) (size-of-int8_t))
((eq? type 'uint8) (size-of-uint8_t)) ((eq? type 'uint8) (size-of-uint8_t))
@ -42,16 +41,23 @@
((eq? type 'float) (size-of-float)) ((eq? type 'float) (size-of-float))
((eq? type 'double) (size-of-double)) ((eq? type 'double) (size-of-double))
((eq? type 'pointer) (size-of-void*)) ((eq? type 'pointer) (size-of-void*))
((eq? type 'callback) (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 (pffi-shared-object-load headers) #;(define-macro
`@,(map (lambda (header) (include-c-headers headers)
'(c-declare ,(string-append "#include <" header ">"))) `(c-declare ,(apply string-append
headers)) (map
(lambda (header)
(string-append "#include <" header ">" (string #\newline)))
(list "stdio.h")))))
(define-macro
#;(define-syntax pffi-shared-object-load (pffi-shared-object-auto-load headers object-name . options)
(syntax-rules () `(c-declare ,(apply string-append
((_ headers) (map
(c-declare "#include <stdint.h>")))) (lambda (header)
(string-append "#include <" header ">" (string #\newline)))
(cdr headers)))))