diff --git a/retropikzel/r7rs-pffi/chibi.scm b/retropikzel/r7rs-pffi/chibi.scm index 3fc9740..2bd4d32 100644 --- a/retropikzel/r7rs-pffi/chibi.scm +++ b/retropikzel/r7rs-pffi/chibi.scm @@ -138,26 +138,28 @@ (define pffi-type->libffi-type (lambda (type) (cond - ;((equal? type 'int8_t) ffi_type_sint8) - ;((equal? type 'uint8_t) ffi_type_uint8) - ;((equal? type 'int16_t) ffi_type_sint16) - ;((equal? type 'uint16_t) ffi_type_uint16) - ;((equal? type 'int32_t) ffi_type_sint32) - ;((equal? type 'uint32_t) ffi_type_uint32) - ;((equal? type 'int64_t) ffi_type_sint64) - ;((equal? type 'uint64_t) ffi_type_uint64) - ;((equal? type 'bool) ffi_type_sint8) - ;((equal? type 'short) ffi_type_sint16) - ;((equal? type 'unsigned-short) ffi_type_uint16) - ((equal? type 'int) (get-ffi-type-sint)) - ;((equal? type 'unsigned-int) ffi_type_uint32) - ;((equal? type 'long) ffi_type_long) - ;((equal? type 'unsigned-long) ffi_type_uint32) - ;((equal? type 'float) ffi_type_float) - ;((equal? type 'double) ffi_type_double) - ;((equal? type 'void) ffi_type_void) + ((equal? type 'int8_t) (get-ffi-type-int8)) + ((equal? type 'uint8_t) (get-ffi-type-uint8)) + ((equal? type 'int16_t) (get-ffi-type-int16)) + ((equal? type 'uint16_t) (get-ffi-type-uint16)) + ((equal? type 'int32_t) (get-ffi-type-int32)) + ((equal? type 'uint32_t) (get-ffi-type-uint32)) + ((equal? type 'int64_t) (get-ffi-type-int64)) + ((equal? type 'uint64_t) (get-ffi-type-uint64)) + ((equal? type 'char) (get-ffi-type-char)) + ((equal? type 'unsigned-char) (get-ffi-type-uchar)) + ((equal? type 'bool) (get-ffi-type-int8)) + ((equal? type 'short) (get-ffi-type-short)) + ((equal? type 'unsigned-short) (get-ffi-type-ushort)) + ((equal? type 'int) (get-ffi-type-int)) + ((equal? type 'unsigned-int) (get-ffi-type-uint)) + ((equal? type 'long) (get-ffi-type-long)) + ((equal? type 'unsigned-long) (get-ffi-type-ulong)) + ((equal? type 'float) (get-ffi-type-float)) + ((equal? type 'double) (get-ffi-type-double)) + ((equal? type 'void) (get-ffi-type-void)) ((equal? type 'pointer) (get-ffi-type-pointer)) - ;((equal? type 'callback) ffi_type_pointer) + ((equal? type 'callback) (get-ffi-type-pointer)) ))) (define make-c-function @@ -169,14 +171,13 @@ (when (not (pffi-pointer-null? maybe-dlerror)) (error (pffi-pointer->string maybe-dlerror))) (lambda (argument-1 . arguments) - (cond ((equal? return-type 'int) - (internal-ffi-call (length argument-types) - (pffi-type->libffi-type return-type) - (map pffi-type->libffi-type argument-types) - func - return-value - (append (list argument-1) arguments)) - (pffi-pointer-get return-value 'int 0))))))) + (internal-ffi-call (length argument-types) + (pffi-type->libffi-type return-type) + (map pffi-type->libffi-type argument-types) + func + return-value + (append (list argument-1) arguments)) + (pffi-pointer-get return-value return-type 0))))) (define-syntax pffi-define (syntax-rules () diff --git a/retropikzel/r7rs-pffi/chibi.stub b/retropikzel/r7rs-pffi/chibi.stub index d1a4bbb..0791b36 100644 --- a/retropikzel/r7rs-pffi/chibi.stub +++ b/retropikzel/r7rs-pffi/chibi.stub @@ -177,17 +177,55 @@ (c-declare "ffi_cif cif;") (define-c (pointer void*) dlsym ((maybe-null void*) string)) +(c-declare "void* get_ffi_type_int8() { return &ffi_type_sint8; }") +(define-c (pointer void*) (get-ffi-type-int8 get_ffi_type_int8) ()) +(c-declare "void* get_ffi_type_uint8() { return &ffi_type_uint8; }") +(define-c (pointer void*) (get-ffi-type-uint8 get_ffi_type_uint8) ()) +(c-declare "void* get_ffi_type_int16() { return &ffi_type_sint16; }") +(define-c (pointer void*) (get-ffi-type-int16 get_ffi_type_int16) ()) +(c-declare "void* get_ffi_type_uint16() { return &ffi_type_uint16; }") +(define-c (pointer void*) (get-ffi-type-uint16 get_ffi_type_uint16) ()) -;(define-c-type ffi_status) -;(define-c-type ffi_cif) -;(define-c-type ffi_type) -;(define-c-type ffi_status) +(c-declare "void* get_ffi_type_int32() { return &ffi_type_sint32; }") +(define-c (pointer void*) (get-ffi-type-int32 get_ffi_type_int32) ()) +(c-declare "void* get_ffi_type_uint32() { return &ffi_type_uint32; }") +(define-c (pointer void*) (get-ffi-type-uint32 get_ffi_type_uint32) ()) -;(c-declare "ffi_type* test1() { ffi_type* p = malloc(sizeof(ffi_type_sint32)); p->size = &ffi_type_sint32->size; return p; }") -;(define-c ffi_type test1 ()) -(c-declare "void* get_ffi_type_sint() { return &ffi_type_sint; }") -(define-c (pointer void*) (get-ffi-type-sint get_ffi_type_sint) ()) +(c-declare "void* get_ffi_type_int64() { return &ffi_type_sint64; }") +(define-c (pointer void*) (get-ffi-type-int64 get_ffi_type_int64) ()) +(c-declare "void* get_ffi_type_uint64() { return &ffi_type_uint64; }") +(define-c (pointer void*) (get-ffi-type-uint64 get_ffi_type_uint64) ()) + +(c-declare "void* get_ffi_type_char() { return &ffi_type_schar; }") +(define-c (pointer void*) (get-ffi-type-char get_ffi_type_char) ()) +(c-declare "void* get_ffi_type_uchar() { return &ffi_type_uchar; }") +(define-c (pointer void*) (get-ffi-type-uchar get_ffi_type_uchar) ()) + +(c-declare "void* get_ffi_type_short() { return &ffi_type_sshort; }") +(define-c (pointer void*) (get-ffi-type-short get_ffi_type_short) ()) +(c-declare "void* get_ffi_type_ushort() { return &ffi_type_ushort; }") +(define-c (pointer void*) (get-ffi-type-ushort get_ffi_type_ushort) ()) + +(c-declare "void* get_ffi_type_int() { return &ffi_type_sint; }") +(define-c (pointer void*) (get-ffi-type-int get_ffi_type_int) ()) +(c-declare "void* get_ffi_type_uint() { return &ffi_type_uint; }") +(define-c (pointer void*) (get-ffi-type-uint get_ffi_type_uint) ()) + +(c-declare "void* get_ffi_type_long() { return &ffi_type_slong; }") +(define-c (pointer void*) (get-ffi-type-long get_ffi_type_long) ()) + +(c-declare "void* get_ffi_type_ulong() { return &ffi_type_ulong; }") +(define-c (pointer void*) (get-ffi-type-ulong get_ffi_type_ulong) ()) + +(c-declare "void* get_ffi_type_float() { return &ffi_type_float; }") +(define-c (pointer void*) (get-ffi-type-float get_ffi_type_float) ()) + +(c-declare "void* get_ffi_type_double() { return &ffi_type_double; }") +(define-c (pointer void*) (get-ffi-type-double get_ffi_type_double) ()) + +(c-declare "void* get_ffi_type_void() { return &ffi_type_void; }") +(define-c (pointer void*) (get-ffi-type-void get_ffi_type_void) ()) (c-declare "void* get_ffi_type_pointer() { return &ffi_type_pointer; }") (define-c (pointer void*) (get-ffi-type-pointer get_ffi_type_pointer) ()) diff --git a/test.scm b/test.scm index 0094d09..9db87a3 100644 --- a/test.scm +++ b/test.scm @@ -355,14 +355,16 @@ (print-header 'pffi-define) (pffi-define puts libc-stdlib 'puts 'int (list 'pointer)) -(display "HERE: ") -(write (puts (pffi-string->pointer "Hello from testing, I am C function puts"))) -(newline) +(let ((chars-writter (puts (pffi-string->pointer "Hello from testing, I am C function puts")))) + (display "I have written: ") + (display chars-writter) + (display " characters.") + (newline)) -#| (pffi-define atoi libc-stdlib 'atoi 'int (list 'pointer)) (assert = (atoi (pffi-string->pointer "100")) 100) +#| ;; pffi-define-callback (print-header 'pffi-define-callback)