[MIT-Scheme-devel] [PATCH] Add basic support for struct params / return types.

[Peter Feigl]

This patch adds support for struct parameter and return types.
Functions that return a struct take an additional first alien
parameter (like functions returning pointers), which must point to a
memory area large enough to hold the struct data. This can for example
be allocated by MALLOC inside Scheme. Thus a struct is implicitly
converted to a struct*.
Functions that take a struct parameter actually assume a struct* as a
parameter, and internally copy the data into a struct that is passed to
the actual C function invocation.
This is not ideal, as extra memory needs to be allocated for structs,
however it allows to access such APIs, which isn't possible without
custom C wrapper functions without this patch (which would probably do
something similar).
---
 src/ffi/generator.scm   |  9 +++++++--
 src/microcode/pruxffi.c | 22 ++++++++++++++++++++++
 src/microcode/pruxffi.h |  1 +
 3 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/src/ffi/generator.scm b/src/ffi/generator.scm
index 1a4f098..c4774ea 100644
--- a/src/ffi/generator.scm
+++ b/src/ffi/generator.scm
@@ -189,7 +189,7 @@ Scm_"name" (void)
         (string-append "
   "ret-var"s = unspecific();")
         (string-append "
-  "ret-var"s = "(callout-return-converter ctype)" ("ret-var");")) "
+  "ret-var"s = "(callout-return-converter ctype)" ("(if (ctype/struct? ctype) 
(string-append "&"ret-var",sizeof("(decl-string ret-ctype)")") ret-var)");")) "
   callout_pop ("tos-var");
   return ("ret-var"s);")))
 
@@ -214,7 +214,9 @@ Scm_"name" (void)
 
 (define (callout-inits ret-ctype params includes)
   ;; Returns a multi-line string in C syntax for the Init section.
-  (let* ((alien-ret-arg? (ctype/pointer? (definite-ctype ret-ctype includes)))
+  (let* ((alien-ret-arg? (let ((definite-ret-ctype (definite-ctype ret-ctype 
includes)))
+                          (or (ctype/pointer? definite-ret-ctype)
+                              (ctype/struct? definite-ret-ctype))))
         (nargs
          ;; (c-call 1:alien-function 2:ret-alien 3:arg1)
          ;; (c-call 1:alien-function 2:arg1)
@@ -274,6 +276,8 @@ Scm_"name" (void)
             ((UCHAR USHORT UINT ULONG) "arg_ulong")
             ((FLOAT DOUBLE) "arg_double")
             (else (error "Unexpected parameter type:" arg-ctype))))
+         ((ctype/struct? ctype)
+          (string-append "*("decl"*) arg_pointer"))
          (else (error "Unexpected parameter type:" arg-ctype)))))
 
 (define (callout-return-converter ctype)
@@ -282,6 +286,7 @@ Scm_"name" (void)
   ;; pointer converter, pointer_to_scm, returns pointers via c-call's
   ;; second argument.
   (cond ((ctype/pointer? ctype) "pointer_to_scm")
+       ((ctype/struct? ctype) "struct_to_scm")
        ((ctype/enum? ctype) "ulong_to_scm")
        ((ctype/basic? ctype)
         (case ctype
diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index 268f018..65d4cba 100644
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -32,6 +32,7 @@ USA.
 #include "history.h"
 #include "floenv.h"
 #include "pruxffi.h"
+#include "string.h"
 /* Using SCM instead of SCHEME_OBJECT here, hoping to ensure that
    these types always match. */
 
@@ -886,6 +887,27 @@ pointer_to_scm (const void * p)
 }
 
 SCM
+struct_to_scm (const void *p, int size)
+{
+  /* Return a pointer from a callout.  Expect the first real argument
+     (the 2nd) to be either #F or an alien, which has enough memory
+     malloc'ed to hold the struct. */
+
+  SCM arg = ARG_REF (2);
+  if (arg == SHARP_F)
+    return (UNSPECIFIC);
+  if (is_alien (arg))
+    {
+      memcpy(alien_address (arg), p, size);
+      return (arg);
+    }
+
+  error_wrong_type_arg (2);
+  /* NOTREACHED */
+  return (SHARP_F);
+}
+
+SCM
 cons_alien (const void * addr)
 {
   /* Construct an alien.  Used by callback kernels to construct
diff --git a/src/microcode/pruxffi.h b/src/microcode/pruxffi.h
index 6e86140..cf44555 100644
--- a/src/microcode/pruxffi.h
+++ b/src/microcode/pruxffi.h
@@ -76,6 +76,7 @@ extern SCM long_to_scm (const long i);
 extern SCM ulong_to_scm (const unsigned long i);
 extern SCM double_to_scm (const double d);
 extern SCM pointer_to_scm (const void* p);
+extern SCM struct_to_scm (const void* p, int size);
 
 extern SCM cons_alien (const void* p);
 
-- 
1.8.0.1