Finishing pffi-define for Chibi

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 ()

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) ())

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)