ffi: new ptr-out-s type.

One more ptr type is useful. This type is for objects returned via
pointers embedded in arrays or structures, whereby the callee
establishes both the pointer and the data.

This is similar to ptr-out-d; the difference is that the
data has an indefinite lifetime ("s" denotes "static")
and so the pointer is not freed after the call takes place
and the data is extracted into Lisp objects.

* ffi.c (ptr_out_s_s): New symbol variable.
(ffi_ptr_out_s_in): New function.
(ffi_type_compile): Handle new ptr_out_s_s.
(ffi_init): Initialize ptr_out_s.

* ffi.h (ptr_out_s_s): Declared.

2 files changed, 22 insertions, 2 deletions

diff --git a/ffi.c b/ffi.c
index 8664ea64..bb7b4d26 100644
--- a/ffi.c
+++ b/ffi.c
@@ -77,7 +77,7 @@ val str_d_s, wstr_s, wstr_d_s;
 
 val buf_d_s;
 
-val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_s;
+val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s;
 
 val closure_s;
 
@@ -786,6 +786,18 @@ static void ffi_ptr_out_null_put(struct txr_ffi_type *tft, val s, mem_t *dst,
   *coerce(mem_t **, dst) =  0;
 }
 
+static val ffi_ptr_out_s_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)
+    obj = tgtft->in(tgtft, *loc, obj, self);
+  return obj;
+}
+
+
 static val ffi_struct_in(struct txr_ffi_type *tft, mem_t *src, val strct,
                          val self)
 {
@@ -1298,6 +1310,13 @@ val ffi_type_compile(val syntax)
                                    ffi_ptr_in_put, ffi_ptr_get,
                                    ffi_ptr_out_in, ffi_ptr_out_out,
                                    target_type);
+    } else if (sym == ptr_out_s_s) {
+      val target_type = ffi_type_compile(cadr(syntax));
+      return make_ffi_type_pointer(syntax, cptr_s, sizeof (mem_t *),
+                                   &ffi_type_pointer,
+                                   ffi_ptr_out_null_put, ffi_ptr_get,
+                                   ffi_ptr_out_s_in, ffi_ptr_out_out,
+                                   target_type);
     } else if (sym == buf_s || sym == buf_d_s) {
       cnum nelem = c_num(cadr(syntax));
       val type = make_ffi_type_builtin(syntax, cptr_s, sizeof (mem_t *),
@@ -1792,6 +1811,7 @@ void ffi_init(void)
   ptr_out_s = intern(lit("ptr-out"), user_package);
   ptr_in_d_s = intern(lit("ptr-in-d"), user_package);
   ptr_out_d_s = intern(lit("ptr-out-d"), user_package);
+  ptr_out_s_s = intern(lit("ptr-out-s"), user_package);
   ptr_s = intern(lit("ptr"), user_package);
   closure_s = intern(lit("closure"), user_package);
   ffi_type_s = intern(lit("ffi-type"), user_package);
diff --git a/ffi.h b/ffi.h
index 77896b00..7561689e 100644
--- a/ffi.h
+++ b/ffi.h
@@ -45,7 +45,7 @@ extern val str_d_s, wstr_s, wstr_d_s;
 
 extern val buf_d_s;
 
-extern val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_s;
+extern val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s;
 
 extern val closure_s;