foreign-c/retropikzel/pffi/larceny.scm

60 lines
1.7 KiB
Scheme

(require 'std-ffi)
(require 'ffi-load)
;; FIXME
(define size-of-type
(lambda (type)
(cond ((eq? type 'int8) 1)
((eq? type 'uint8) 1)
((eq? type 'int16) 2)
((eq? type 'uint16) 2)
((eq? type 'int32) 4)
((eq? type 'uint32) 4)
((eq? type 'int64) 8)
((eq? type 'uint64) 8)
((eq? type 'char) 1)
((eq? type 'unsigned-char) 1)
((eq? type 'short) 2)
((eq? type 'unsigned-short) 2)
((eq? type 'int) 4)
((eq? type 'unsigned-int) 4)
((eq? type 'long) 4)
((eq? type 'unsigned-long) 4)
((eq? type 'float) 4)
((eq? type 'double) 8)
((eq? type 'pointer) sizeof:pointer)
((eq? type 'void) 0)
((eq? type 'callback) sizeof:pointer)
(else (error "Can not get size of unknown type" type)))))
(define c-bytevector?
(lambda (object)
;(void*? object)
(number? object)))
(define pffi-shared-object-load
(lambda (headers path . options)
(foreign-file path)))
(define c-bytevector-u8-ref
(lambda (c-bytevector k)
(peek-bytes c-bytevector k (c-size-of 'uint8))))
(define-syntax define-c-procedure
(syntax-rules ()
((_ scheme-name shared-object c-name return-type argument-types)
(define scheme-name
0
#;(make-c-function shared-object
(symbol->string c-name)
return-type
argument-types)))))
(define-syntax pffi-define-callback
(syntax-rules ()
((_ scheme-name return-type argument-types procedure)
(define scheme-name
0
#;(make-c-callback return-type argument-types procedure)))))