ffi: issue with struct/vector slots that are nil.

The problem is as follows. When an aggregate is being passed
by pointer, the C code can update its elements. If any of
those elements are declared arrays or structs to FFI, but the
actual Lips object has nil slot values for those elements,
then things don't work, because nil cannot be mutated in
place to become a filled vector or struct.

The solution is to alter the in virtual function so that it
can return a value, just like the get virtual function.  When
the in function for an array or struct finds it is working
with a nil Lisp object, it can construct a representative
instance and fill in that one, then return it.

* ffi.c (struct txr_ffi_type): Change return type of in
function to val.
(ffi_freeing_in, ffi_ptr_in_in, ffi_ptr_out_in): Return type
changes to val, obj that is passed in is returned.
(ffi_struct_in): Return type changes to val. If the Lisp
structure passed in is nil, then construct a default instance
of the structure by invoking make_struct on the type, with no
arguments, and then operate on that structure.  In either
case, return the structure.
(ffi_array_in): Similar change to ffi_struct_in. In the cases
when we are converting character arrays to strings, if the
Lisp object is nil, we just take the decoded string as
the array and return that. In the regular array case, we
check for the object being nil, and if so, construct an empty
vector in the right size, then fill it.
(make_ffi_type_pointer): in parameter's return type
changes to val.

1 files changed, 33 insertions, 19 deletions

diff --git a/ffi.c b/ffi.c
index d1cc87cc..9227fbe0 100644
--- a/ffi.c
+++ b/ffi.c
@@ -98,7 +98,7 @@ struct txr_ffi_type {
   unsigned wchar_conv : 1;
   void (*put)(struct txr_ffi_type *, val obj, mem_t *dst, val self);
   val (*get)(struct txr_ffi_type *, mem_t *src, val self);
-  void (*in)(struct txr_ffi_type *, mem_t *src, val obj, val self);
+  val (*in)(struct txr_ffi_type *, mem_t *src, val obj, val self);
   void (*out)(struct txr_ffi_type *, int copy, val obj, mem_t *dest, val self);
   mem_t *(*alloc)(struct txr_ffi_type *, val obj, val self);
   void (*free)(void *);
@@ -548,12 +548,13 @@ static mem_t *ffi_cptr_alloc(struct txr_ffi_type *tft, val ptr, val self)
   return coerce(mem_t *, cptr_addr_of(ptr));
 }
 
-static void ffi_freeing_in(struct txr_ffi_type *tft, mem_t *src, val obj,
-                           val self)
+static val ffi_freeing_in(struct txr_ffi_type *tft, mem_t *src, val obj,
+                          val self)
 {
   mem_t **loc = coerce(mem_t **, src);
   free(*loc);
   *loc = 0;
+  return obj;
 }
 
 static void ffi_str_put(struct txr_ffi_type *tft, val s, mem_t *dst,
@@ -687,14 +688,15 @@ static void ffi_closure_put(struct txr_ffi_type *tft, val ptr, mem_t *dst,
   memcpy(dst, &p, sizeof p);
 }
 
-static void ffi_ptr_in_in(struct txr_ffi_type *tft, mem_t *src, val obj,
-                          val self)
+static val ffi_ptr_in_in(struct txr_ffi_type *tft, mem_t *src, val obj,
+                         val self)
 {
   val tgttype = tft->mtypes;
   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
   mem_t **loc = coerce(mem_t **, src);
   tgtft->free(*loc);
   *loc = 0;
+  return obj;
 }
 
 static void ffi_ptr_in_put(struct txr_ffi_type *tft, val s, mem_t *dst,
@@ -737,16 +739,17 @@ static void ffi_ptr_in_d_put(struct txr_ffi_type *tft, val s, mem_t *dst,
   }
 }
 
-static void ffi_ptr_out_in(struct txr_ffi_type *tft, mem_t *src, val obj,
-                           val self)
+static val ffi_ptr_out_in(struct txr_ffi_type *tft, mem_t *src, val obj,
+                          val self)
 {
   val tgttype = tft->mtypes;
   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
   mem_t **loc = coerce(mem_t **, src);
   if (tgtft->in != 0)
-    tgtft->in(tgtft, *loc, obj, self);
+    obj = tgtft->in(tgtft, *loc, obj, self);
   tgtft->free(*loc);
   *loc = 0;
+  return obj;
 }
 
 static void ffi_ptr_out_put(struct txr_ffi_type *tft, val s, mem_t *dst,
@@ -805,13 +808,18 @@ static void ffi_ptr_put(struct txr_ffi_type *tft, val s, mem_t *dst, val self)
   }
 }
 
-static void ffi_struct_in(struct txr_ffi_type *tft, mem_t *src, val strct,
-                          val self)
+static val ffi_struct_in(struct txr_ffi_type *tft, mem_t *src, val strct,
+                         val self)
 {
   val slots = tft->mnames;
   val types = tft->mtypes;
   ucnum offs = 0;
 
+  if (strct == nil) {
+    args_decl(args, 0);
+    strct = make_struct(tft->lt, nil, args);
+  }
+
   while (slots) {
     val slsym = pop(&slots);
     val type = pop(&types);
@@ -821,7 +829,7 @@ static void ffi_struct_in(struct txr_ffi_type *tft, mem_t *src, val strct,
     if (slsym) {
       if (mtft->in != 0) {
         val slval = slot(strct, slsym);
-        mtft->in(mtft, src + offs, slval, self);
+        slotset(strct, slsym, mtft->in(mtft, src + offs, slval, self));
       } else {
         val slval = mtft->get(mtft, src + offs, self);
         slotset(strct, slsym, slval);
@@ -829,6 +837,8 @@ static void ffi_struct_in(struct txr_ffi_type *tft, mem_t *src, val strct,
     }
     offs += mtft->size;
   }
+
+  return strct;
 }
 
 static void ffi_struct_put(struct txr_ffi_type *tft, val strct, mem_t *dst,
@@ -903,8 +913,8 @@ static val ffi_struct_get(struct txr_ffi_type *tft, mem_t *src, val self)
   return strct;
 }
 
-static void ffi_array_in(struct txr_ffi_type *tft, mem_t *src, val vec,
-                         val self)
+static val ffi_array_in(struct txr_ffi_type *tft, mem_t *src, val vec,
+                        val self)
 {
   val eltype = tft->mtypes;
   cnum nelem = tft->nelem;
@@ -923,7 +933,7 @@ static void ffi_array_in(struct txr_ffi_type *tft, mem_t *src, val vec,
         str = string_own(wch);
       }
     }
-    replace(vec, str, zero, t);
+    vec = if3(vec, replace(vec, str, zero, t), str);
   } else if (tft->wchar_conv) {
     val str;
 
@@ -940,17 +950,19 @@ static void ffi_array_in(struct txr_ffi_type *tft, mem_t *src, val vec,
         str = init_str(ustr, wchptr);
       }
     }
-    replace(vec, str, zero, t);
+    vec = if3(vec, replace(vec, str, zero, t), str);
   } else {
     ucnum offs = 0;
     struct txr_ffi_type *etft = ffi_type_struct(eltype);
     cnum elsize = etft->size, i;
 
-    for (i = 0; i < nelem; i++) {
+    if (vec == nil)
+      vec = vector(num_fast(nelem), nil);
 
+    for (i = 0; i < nelem; i++) {
       if (etft->in != 0) {
         val elval = ref(vec, num_fast(i));
-        etft->in(etft, src + offs, elval, self);
+        refset(vec, num_fast(i), etft->in(etft, src + offs, elval, self));
       } else {
         val elval = etft->get(etft, src + offs, self);
         refset(vec, num_fast(i), elval);
@@ -958,6 +970,8 @@ static void ffi_array_in(struct txr_ffi_type *tft, mem_t *src, val vec,
       offs += elsize;
     }
   }
+
+  return vec;
 }
 
 static void ffi_array_put(struct txr_ffi_type *tft, val vec, mem_t *dst,
@@ -1082,8 +1096,8 @@ static val make_ffi_type_pointer(val syntax, val lisp_type,
                                              mem_t *dst, val self),
                                  val (*get)(struct txr_ffi_type *,
                                             mem_t *src, val self),
-                                 void (*in)(struct txr_ffi_type *, mem_t *src,
-                                            val obj, val self),
+                                 val (*in)(struct txr_ffi_type *, mem_t *src,
+                                           val obj, val self),
                                  void (*out)(struct txr_ffi_type *, int copy,
                                              val obj, mem_t *dst, val self),
                                  val tgtype)