From ad102c8e19b2aa69b0647dbf1c72c9402de4c79d Mon Sep 17 00:00:00 2001
From: "Paul A. Patience" <paul@apatience.com>
Date: Sat, 2 Oct 2021 01:30:37 -0400
Subject: ffi: add cptr-carray function.

* ffi.c (cptr_carray): New function.
(ffi_init): Register cptr-carray intrinsic.

* ffi.h (cptr_carray): Declared.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 ffi.c              |  9 +++++++++
 ffi.h              |  1 +
 stdlib/doc-syms.tl |  1 +
 txr.1              | 36 ++++++++++++++++++++++++++++++++++++
 4 files changed, 47 insertions(+)

diff --git a/ffi.c b/ffi.c
index dc92c5b2..b857ecb2 100644
--- a/ffi.c
+++ b/ffi.c
@@ -5549,6 +5549,14 @@ val carray_cptr(val cptr, val type, val len)
   return make_carray(type, data, nelem, nil, 0);
 }
 
+val cptr_carray(val carray, val type_sym_in)
+{
+  val self = lit("cptr-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
+  val type_sym = default_null_arg(type_sym_in);
+  return cptr_typed(scry->data, type_sym, 0);
+}
+
 val vec_carray(val carray, val null_term_p)
 {
   val self = lit("vec-carray");
@@ -6779,6 +6787,7 @@ void ffi_init(void)
   reg_fun(intern(lit("carray-buf-sync"), user_package), func_n1(carray_buf_sync));
   reg_fun(intern(lit("buf-carray"), user_package), func_n1(buf_carray));
   reg_fun(intern(lit("carray-cptr"), user_package), func_n3o(carray_cptr, 2));
+  reg_fun(intern(lit("cptr-carray"), user_package), func_n2o(cptr_carray, 1));
   reg_fun(intern(lit("vec-carray"), user_package), func_n2o(vec_carray, 1));
   reg_fun(intern(lit("list-carray"), user_package), func_n2o(list_carray, 1));
   reg_fun(intern(lit("carray-ref"), user_package), func_n2(carray_ref));
diff --git a/ffi.h b/ffi.h
index 4029f450..d788d9e8 100644
--- a/ffi.h
+++ b/ffi.h
@@ -111,6 +111,7 @@ val carray_buf(val buf, val type, val offs);
 val carray_buf_sync(val carray);
 val buf_carray(val carray);
 val carray_cptr(val cptr, val type, val len);
+val cptr_carray(val carray, val type_sym_in);
 val vec_carray(val carray, val null_term_p);
 val list_carray(val carray, val null_term_p);
 val carray_ref(val carray, val idx);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index b51932ba..d88c3b0b 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -419,6 +419,7 @@
       ("countqual" "N-01DF131F")
       ("cptr" "D-0013")
       ("cptr-buf" "N-037139E3")
+      ("cptr-carray" "N-02257F04")
       ("cptr-cast" "N-01A212ED")
       ("cptr-free" "N-02B1FBEF")
       ("cptr-get" "N-00513A70")
diff --git a/txr.1 b/txr.1
index bbfdde5b..b906d8c0 100644
--- a/txr.1
+++ b/txr.1
@@ -80880,6 +80880,42 @@ length of the array.
 
 Note: this conversion is inherently unsafe.
 
+.coNP Function @ cptr-carray
+.synb
+.mets (cptr-carray < carray <> [ type-symbol ])
+.syne
+.desc
+The
+.code cptr-carray
+function returns a
+.code cptr
+object which holds a pointer to a
+.code carray
+object's storage area. The
+.meta carray
+argument must be of type
+.codn carray .
+
+The
+.meta type-symbol
+argument should be a symbol. If omitted, it defaults to
+.codn nil .
+This symbol becomes the
+.code cptr
+object's type tag.
+
+The lifetime of the returned
+.code cptr
+object is independent from that of
+.metn carray .
+If the lifetime of
+.meta carray
+reaches its end before that of the
+.codn cptr ,
+the pointer stored inside the
+.code cptr
+becomes invalid.
+
 .coNP Function @ length-carray
 .synb
 .mets (length-carray << carray )
-- 
cgit v1.2.3