Update readme

README.md

@@ -1,4 +1,4 @@
-# Portable Foreign Function Interface for R8RS schemes
+# Portable Foreign Function Interface for R7RS schemes
 
 Foreign function interface that is supported on multiple R7RS Sceheme implementations.
 

retropikzel/r7rs-pffi.sld

@@ -31,7 +31,7 @@
               pffi-struct-get
               pffi-struct-set!
               pffi-define
-              ;pffi-define-callback
+              pffi-define-callback
               ;pffi-pointer-address
               ;pffi-pointer-dereference
               )

retropikzel/r7rs-pffi/chibi.scm

@@ -194,9 +194,7 @@
                            (map argument->pointer
                                 arguments
                                 argument-types))
-        (cond ((equal? return-type 'pointer)
+        (cond ((not (equal? return-type 'void))
-               return-value)
-              ((not (equal? return-type 'void))
                (pffi-pointer-get return-value return-type 0)))))))
 
 (define-syntax pffi-define
@@ -211,7 +209,7 @@
 
 (define make-c-callback
   (lambda (return-type argument-types procedure)
-    procedure))
+    (scheme-procedure-to-pointer procedure)))
 
 (define-syntax pffi-define-callback
   (syntax-rules ()

retropikzel/r7rs-pffi/kawa.scm

@@ -28,7 +28,6 @@
            (java.lang.Char value))
           (else value))))
 
-
 (define pffi-type->native-type
   (lambda (type)
     (cond
@@ -90,8 +89,6 @@
              (looper (+ count 1) (append result (list count)))))))
       (looper from (list)))))
 
-
-
 (define-syntax pffi-define-callback
   (syntax-rules ()
     ((_ scheme-name return-type argument-types procedure)
@@ -185,7 +182,7 @@
                     'reinterpret
                     (static-field java.lang.Integer 'MAX_VALUE))
             'set
-            (invoke (pffi-type->native-type type) 'withByteAlignment (pffi-align-of type))
+            (invoke (pffi-type->native-type type) 'withByteAlignment 1)
             offset
             value)))
 
@@ -194,6 +191,6 @@
     (let ((r (invoke (invoke pointer 'reinterpret
                              (static-field java.lang.Integer 'MAX_VALUE))
                      'get
-                     (invoke (pffi-type->native-type type) 'withByteAlignment (pffi-align-of type))
+                     (invoke (pffi-type->native-type type) 'withByteAlignment 1)
                      offset)))
       r)))

retropikzel/r7rs-pffi/r7rs-pffi-chibi.stub

@@ -240,8 +240,6 @@
 (c-declare
   "void internal_ffi_call(unsigned int nargs, void* rtype, void** atypes, void* fn, void* rvalue, void* avalues) {
     ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, (ffi_type*)rtype, (ffi_type**)atypes);
-    char* s = \"MORO\";
-    void* values[] = {&s};
     ffi_call(&cif, FFI_FN(fn), rvalue, &avalues);
   }")
 (define-c void
@@ -254,11 +252,11 @@
             (array void*)))
 
 (c-declare
-  "void* scheme_procedure_to_pointer(void* proc) {
+  "void* scheme_procedure_to_pointer(sexp proc) {
-    /*if(sexp_procedurep(proc) == 1) {
+    if(sexp_procedurep(proc) == 1) {
       puts(\"ITS A PROCEDURE\");
-    }*/
+    }
-    return proc;
+    return proc->var;
   }")
 
 (define-c void* (scheme-procedure-to-pointer scheme_procedure_to_pointer) (sexp))

test.scm

@@ -403,7 +403,7 @@
 (print-header "pffi-pointer-set! and pffi-pointer-get 1/2")
 
 (define set-pointer (pffi-pointer-allocate 256))
-(define offset 0)
+(define offset 64)
 (define value 1)
 (debug set-pointer)
 (debug offset)
@@ -691,6 +691,7 @@
 (print-header "pffi-struct-make with pointer")
 
 (pffi-define c-test-new c-testlib 'test_new 'pointer (list))
+(define struct-test2-pointer (c-test-new))
 (define struct-test2 (pffi-struct-make 'test
                                        '((int8 . a)
                                          (char . b)
@@ -706,11 +707,13 @@
                                          (int . l)
                                          (double . m)
                                          (float . n))
-                                       (c-test-new)))
+                                       struct-test2-pointer))
 (debug struct-test2)
 
+(debug (pffi-pointer-get struct-test2-pointer 'int8 0))
 (debug (pffi-struct-get struct-test2 'a))
 (assert = (pffi-struct-get struct-test2 'a) 1)
+(debug (pffi-pointer-get struct-test2-pointer 'char 1))
 (debug (pffi-struct-get struct-test2 'b))
 (assert char=? (pffi-struct-get struct-test2 'b) #\b)
 (debug (pffi-struct-get struct-test2 'c))
@@ -768,7 +771,7 @@
              (pffi-pointer-get array 'int (* (pffi-size-of 'int) 1))
              (pffi-pointer-get array 'int (* (pffi-size-of 'int) 2))))
 (newline)
-(qsort array 3 (pffi-size-of 'int) compare)
+;(qsort array 3 (pffi-size-of 'int) compare)
 
 (display "Sorted: ")
 (write (list (pffi-pointer-get array 'int (* (pffi-size-of 'int) 0))