Added stklos support

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

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