diff --git a/retropikzel/pffi.sld b/retropikzel/pffi.sld index a9e2720..1333eaa 100644 --- a/retropikzel/pffi.sld +++ b/retropikzel/pffi.sld @@ -461,7 +461,7 @@ pffi-struct-offset-get pffi-struct-get pffi-struct-set! - ;pffi-define + pffi-define ;pffi-define-callback )) (tr7 diff --git a/retropikzel/pffi/stklos.scm b/retropikzel/pffi/stklos.scm index 785a04d..dd98f31 100644 --- a/retropikzel/pffi/stklos.scm +++ b/retropikzel/pffi/stklos.scm @@ -26,17 +26,48 @@ (define pffi-pointer? (lambda (object) + (display "HERE: ") + (write object) + (newline) + (write (cpointer? object)) + (newline) (cpointer? object))) (define-syntax pffi-define (syntax-rules () ((pffi-define scheme-name shared-object c-name return-type argument-types) + (begin + (define pffi-type->native-type + (lambda (type) + (cond ((equal? type 'int8) :int) + ((equal? type 'uint8) :uint) + ((equal? type 'int16) :int) + ((equal? type 'uint16) :uint) + ((equal? type 'int32) :int) + ((equal? type 'uint32) :uint) + ((equal? type 'int64) :int) + ((equal? type 'uint64) :uint) + ((equal? type 'char) :char) + ((equal? type 'unsigned-char) :uchar) + ((equal? type 'short) :short) + ((equal? type 'unsigned-short) :ushort) + ((equal? type 'int) :int) + ((equal? type 'unsigned-int) :uint) + ((equal? type 'long) :long) + ((equal? type 'unsigned-long) :ulong) + ((equal? type 'float) :float) + ((equal? type 'double) :double) + ((equal? type 'pointer) :pointer) + ((equal? type 'string) :string) + ((equal? type 'void) :void) + ((equal? type 'struct) :void) + (else (error "pffi-type->native-type -- No such pffi type" type))))) (define scheme-name (make-external-function (symbol->string c-name) (map pffi-type->native-type argument-types) (pffi-type->native-type return-type) - shared-object))))) + shared-object)))))) (define pffi-define-callback (lambda ()