ffi: allow ptr-in-out passing of cptr.

* ffi.c (ffi_ptr_alloc): New static function.
(ffi_type_compile): Give the cptr type alloc and free
functions: alloc just retrives the address of the pointer
inside the cptr object (pointer to pointer); free is a noop.
(cptr_make): New static function.
(ffi_init): Register cptr_make as cptr intrinsic. Register
cptr-null intrinsic variable denoting a ready-made null
pointer.

* lib.c (cptr_addr_of): New function.

* lib.h (cptr_addr_of): Declared.

3 files changed, 27 insertions, 3 deletions

diff --git a/ffi.c b/ffi.c
index f4062eb7..66cdbecc 100644
--- a/ffi.c
+++ b/ffi.c
@@ -561,6 +561,12 @@ static val ffi_ptr_get(struct txr_ffi_type *tft, mem_t *src, val self)
   return cptr(p);
 }
 
+static mem_t *ffi_ptr_alloc(struct txr_ffi_type *tft, val ptr, val self)
+{
+  (void) tft;
+  return coerce(mem_t *, cptr_addr_of(ptr));
+}
+
 static void ffi_freeing_in(struct txr_ffi_type *tft, val obj, val self)
 {
   (void) obj;
@@ -1157,9 +1163,13 @@ val ffi_type_compile(val syntax)
                                  &ffi_type_double,
                                  ffi_double_put, ffi_double_get);
   } else if (syntax == cptr_s) {
-    return make_ffi_type_builtin(syntax, cptr_s, sizeof (mem_t *),
-                                 &ffi_type_pointer,
-                                 ffi_ptr_put, ffi_ptr_get);
+    val type = make_ffi_type_builtin(syntax, cptr_s, sizeof (mem_t *),
+                                     &ffi_type_pointer,
+                                     ffi_ptr_put, ffi_ptr_get);
+    struct txr_ffi_type *tft = ffi_type_struct(type);
+    tft->alloc = ffi_ptr_alloc;
+    tft->free = ffi_noop_free;
+    return type;
   } else if (syntax == str_s) {
     return make_ffi_type_builtin(syntax, cptr_s, sizeof (mem_t *),
                                  &ffi_type_pointer,
@@ -1309,6 +1319,11 @@ val ffi_call_wrap(val ffi_call_desc, val fptr, val args_in)
   return rtft->get(rtft, convert(mem_t *, rc), self);
 }
 
+static val cptr_make(val n)
+{
+  return if3(missingp(n), cptr(0), cptr(coerce(mem_t *, c_num(n))));
+}
+
 void ffi_init(void)
 {
   uint8_s = intern(lit("uint8"), user_package);
@@ -1341,4 +1356,6 @@ void ffi_init(void)
   reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile));
   reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n4(ffi_make_call_desc));
   reg_fun(intern(lit("ffi-call"), user_package), func_n3(ffi_call_wrap));
+  reg_fun(intern(lit("cptr"), user_package), func_n1o(cptr_make, 0));
+  reg_varl(intern(lit("cptr-null"), user_package), cptr(0));
 }
diff --git a/lib.c b/lib.c
index 8eaa81bf..96b18000 100644
--- a/lib.c
+++ b/lib.c
@@ -7361,6 +7361,12 @@ mem_t *cptr_get(val cptr)
   return cobj_handle(cptr, cptr_s);
 }
 
+mem_t **cptr_addr_of(val cptr)
+{
+  (void) cobj_handle(cptr, cptr_s);
+  return &cptr->co.handle;
+}
+
 val assoc(val key, val list)
 {
   list = nullify(list);
diff --git a/lib.h b/lib.h
index 943fd3ac..5c74abf5 100644
--- a/lib.h
+++ b/lib.h
@@ -936,6 +936,7 @@ mem_t *cobj_handle(val cobj, val cls_sym);
 struct cobj_ops *cobj_ops(val cobj, val cls_sym);
 val cptr(mem_t *ptr);
 mem_t *cptr_get(val cptr);
+mem_t **cptr_addr_of(val cptr);
 val assoc(val key, val list);
 val assql(val key, val list);
 val rassoc(val key, val list);