Re: make-c-struct type support

[Ludovic Courtès]

Hello,

Tristan Colgate <address@hidden> writes:

>   Does make-c-struct support poitners, long-integer and integer types?
> A brief grok of the code suggests not. How would one go about
> supporting it in a 32/64 bit agnostic manner?

The following patch (not committed yet) adds support for pointers (and
changes ‘parse-c-struct’ to honor alignment requirements);
‘long-integer’, ‘size_t’, etc., can be added similarly.

What do you think?

Thanks,
Ludo’.

diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 84d1a03..1651d75 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -76,7 +76,15 @@
     (,int32 . ,bytevector-s32-native-set!)
     (,uint32 . ,bytevector-u32-native-set!)
     (,int64 . ,bytevector-s64-native-set!)
-    (,uint64 . ,bytevector-u64-native-set!)))
+    (,uint64 . ,bytevector-u64-native-set!)
+    (*       . ,(let ((write-addr!
+                       (case (sizeof '*)
+                         ((4) bytevector-u32-native-set!)
+                         ((8) bytevector-u64-native-set!)
+                         (else (error "unsupported pointer type")
+                               (sizeof '*)))))
+                  (lambda (bv offset ptr)
+                    (write-addr! bv offset (pointer-address ptr)))))))
 
 (define *readers*
   `((,float . ,bytevector-ieee-single-native-ref)
@@ -88,7 +96,15 @@
     (,int32 . ,bytevector-s32-native-ref)
     (,uint32 . ,bytevector-u32-native-ref)
     (,int64 . ,bytevector-s64-native-ref)
-    (,uint64 . ,bytevector-u64-native-ref)))
+    (,uint64 . ,bytevector-u64-native-ref)
+    (*       . ,(let ((read-addr
+                       (case (sizeof '*)
+                         ((4) bytevector-u32-native-ref)
+                         ((8) bytevector-u64-native-ref)
+                         (else (error "unsupported pointer type")
+                               (sizeof '*)))))
+                  (lambda (bv offset)
+                    (make-pointer (read-addr bv offset)))))))
 
 (define (align off alignment)
   (1+ (logior (1- off) (1- alignment))))
@@ -132,7 +148,8 @@
 
 (define (parse-c-struct foreign types)
   (let ((size (fold (lambda (type total)
-                      (+ (sizeof type) total))
+                      (+ (sizeof type)
+                         (align total (alignof type))))
                     0
                     types)))
     (read-c-struct (pointer->bytevector foreign size) 0 types)))
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index db92eca..8f7fd0a 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -182,4 +182,11 @@
           (data   (list -300 43)))
       (equal? (parse-c-struct (make-c-struct layout data)
                               layout)
+              data)))
+
+  (pass-if "with pointers"
+    (let ((layout (list uint8 '*))
+          (data   (list 222 (make-pointer 7777))))
+      (equal? (parse-c-struct (make-c-struct layout data)
+                              layout)
               data))))