Adding struct dereferencing

Makefile

@@ -18,7 +18,8 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.
 	${CC} -o retropikzel/r7rs-pffi/r7rs-pffi-chibi.so \
 		retropikzel/r7rs-pffi/r7rs-pffi-chibi.c \
 		-fPIC \
-		-lffi
+		-lffi \
+		-shared
 
 test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
 	${CHIBI} test.scm

README.md

@@ -113,6 +113,7 @@ Usage recommended.
 | pffi-struct-offset-get          | X     | X         | X       | X       | X      | X      | X     | X    | X       | X    | X      | X           | X     | X      | X   | X       |
 | pffi-struct-get                 | X     | X         | X       | X       | X      | X      | X     | X    | X       | X    | X      | X           | X     | X      | X   | X       |
 | pffi-struct-set!                | X     | X         | X       | X       | X      | X      | X     | X    | X       | X    | X      | X           | X     | X      | X   | X       |
+| pffi-struct-dereference         |       |           |         |         |        |        |       |      |         |      |        | X           |       |        |     |         |
 | pffi-define                     | X     | X         | X       |         |        |        | X     | X    |         | X    | X      | X           |       |        |     |         |
 | pffi-define-callback            |       | X         |         |         |        |        | X     |      |         | X    | X      | X           |       |        |     |         |
 

retropikzel/r7rs-pffi.sld

@@ -29,9 +29,9 @@
               pffi-struct-offset-get
               pffi-struct-get
               pffi-struct-set!
+              pffi-struct-dereference
               pffi-define
-              pffi-define-callback
+              pffi-define-callback)
-              )
       (include-shared "r7rs-pffi/r7rs-pffi-chibi"))
     (chicken5
       (import (scheme base)
@@ -248,8 +248,7 @@
               pffi-struct-get
               pffi-struct-set!
               pffi-define
-              pffi-define-callback
+              pffi-define-callback))
-              ))
     (kawa
       (import (scheme base)
               (scheme write)
@@ -276,6 +275,7 @@
               pffi-struct-offset-get
               pffi-struct-get
               pffi-struct-set!
+              pffi-struct-dereference
               pffi-define
               pffi-define-callback
               ))
@@ -374,6 +374,7 @@
               pffi-struct-offset-get
               pffi-struct-get
               pffi-struct-set!
+              pffi-struct-dereference
               pffi-define
               pffi-define-callback))
     (sagittarius
@@ -404,6 +405,7 @@
               pffi-struct-offset-get
               pffi-struct-get
               pffi-struct-set!
+              pffi-struct-dereference
               pffi-define
               pffi-define-callback))
     (skint

retropikzel/r7rs-pffi/chibi.scm

@@ -215,6 +215,6 @@
      (define scheme-name
        (make-c-callback return-type argument-types procedure)))))
 
-(define pffi-pointer-dereference
+(define pffi-struct-dereference
-  (lambda (pointer)
+  (lambda (struct)
-    pointer))
+    (pffi-struct-pointer struct)))

retropikzel/r7rs-pffi/kawa.scm

@@ -50,6 +50,7 @@
       ((equal? type 'pointer) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
       ((equal? type 'void) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1))
       ((equal? type 'callback) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
+      ((equal? type 'struct) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
       (else (error "pffi-type->native-type -- No such pffi type" type)))))
 
 (define pffi-pointer?
@@ -191,3 +192,13 @@
       (if (equal? type 'char)
         (integer->char r)
         r))))
+
+(define pffi-struct-dereference
+  (lambda (struct)
+    ;; WIP
+    (pffi-struct-pointer struct)
+    #;(invoke (pffi-struct-pointer struct) 'reinterpret (static-field java.lang.Integer 'MAX_VALUE))
+    #;(invoke (pffi-struct-pointer struct)
+            'get
+            (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1)
+            0)))

retropikzel/r7rs-pffi/racket.scm

@@ -21,6 +21,7 @@
           ((equal? type 'pointer) _pointer)
           ((equal? type 'void) _void)
           ((equal? type 'callback) _pointer)
+          ((equal? type 'struct) _pointer)
           (else (error "pffi-type->native-type -- No such pffi type" type)))))
 
 (define pffi-pointer?
@@ -108,6 +109,6 @@
         (integer->char r)
         r))))
 
-(define pffi-pointer-dereference
+(define pffi-struct-dereference
-  (lambda (pointer)
+  (lambda (struct)
-    pointer))
+    (pffi-struct-pointer struct)))

retropikzel/r7rs-pffi/sagittarius.scm

@@ -22,6 +22,7 @@
           ((equal? type 'string) 'string)
           ((equal? type 'void) 'void)
           ((equal? type 'callback) 'callback)
+          ((equal? type 'struct) 'void*)
           (else (error "pffi-type->native-type -- No such pffi type" type)))))
 
 (define pffi-pointer?
@@ -77,9 +78,9 @@
   (lambda (pointer)
     (address pointer)))
 
-(define pffi-pointer-dereference
+(define pffi-struct-dereference
-  (lambda (pointer)
+  (lambda (struct)
-    (deref pointer 0)))
+    (deref (pffi-struct-pointer struct) 0)))
 
 (define pffi-pointer-null
   (lambda ()

retropikzel/r7rs-pffi/struct.scm

@@ -50,8 +50,6 @@
 (define (pffi-struct-make name members . pointer)
   (for-each
     (lambda (member)
-      (write member)
-      (newline)
       (when (not (pair? member))
         (error "All struct members must be pairs" (list name member)))
       (when (not (symbol? (car member)))