Working on Gambit implementation
This commit is contained in:
parent
1b08e57be2
commit
fe5de3e731
1
Makefile
1
Makefile
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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)))))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue