From 1ebafaf91f4f2bb09a1f4d23d7bfcfa97506a0e8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 19 Jun 2017 23:21:41 -0700
Subject: cptr-int and cptr-obj can make typed cptr objects.

* eval.c (eval_init): Update registration of cptr-int and
cptr-obj with one optional argument.

* lib.c (cptr_int): New type symbol argument, defaulting
to nil. Also, don't bother defaulting the integer argument;
the function isn't registered for that being optional.
(cptr_obj): New type symbol argument, defaulting to nil.

* lib.h (cptr_int, cptr_obj): Declarations updated.

* txr.1: Documented cptr-int and cptr-obj function changes.
Added discussion of type tag to introductory paragraph.
Also added neglected documentation of the FFI cptr type,
both unparametrized and parametrized.
---
 eval.c |   4 +--
 lib.c  |  10 +++---
 lib.h  |   4 +--
 txr.1  | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 4 files changed, 123 insertions(+), 11 deletions(-)

diff --git a/eval.c b/eval.c
index d1c3cc8c..46c9bb72 100644
--- a/eval.c
+++ b/eval.c
@@ -6157,8 +6157,8 @@ void eval_init(void)
   reg_fun(intern(lit("rlcp"), user_package), func_n2(rlcp));
   reg_fun(intern(lit("rlcp-tree"), user_package), func_n2(rlcp_tree));
 
-  reg_fun(intern(lit("cptr-int"), user_package), func_n1(cptr_int));
-  reg_fun(intern(lit("cptr-obj"), user_package), func_n1(cptr_obj));
+  reg_fun(intern(lit("cptr-int"), user_package), func_n2o(cptr_int, 1));
+  reg_fun(intern(lit("cptr-obj"), user_package), func_n2o(cptr_obj, 1));
   reg_fun(intern(lit("cptr-zap"), user_package), func_n1(cptr_zap));
   reg_fun(intern(lit("cptr-free"), user_package), func_n1(cptr_free));
   reg_fun(intern(lit("cptrp"), user_package), func_n1(cptrp));
diff --git a/lib.c b/lib.c
index bf51d9df..80d056b4 100644
--- a/lib.c
+++ b/lib.c
@@ -7531,14 +7531,16 @@ val cptr_type(val cptr)
   return cptr->co.cls;
 }
 
-val cptr_int(val n)
+val cptr_int(val n, val type_sym_in)
 {
-  return if3(missingp(n), cptr(0), cptr(coerce(mem_t *, c_num(n))));
+  val type_sym = default_null_arg(type_sym_in);
+  return cptr_typed(coerce(mem_t *, c_num(n)), type_sym, 0);
 }
 
-val cptr_obj(val obj)
+val cptr_obj(val obj, val type_sym_in)
 {
-  return cptr(coerce(mem_t *, obj));
+  val type_sym = default_null_arg(type_sym_in);
+  return cptr_typed(coerce(mem_t *, obj), type_sym, 0);
 }
 
 val cptr_zap(val cptr)
diff --git a/lib.h b/lib.h
index 24db79f1..ffe10c84 100644
--- a/lib.h
+++ b/lib.h
@@ -957,8 +957,8 @@ val cptr(mem_t *ptr);
 val cptr_typed(mem_t *handle, val type_sym, struct cobj_ops *ops);
 val cptrp(val obj);
 val cptr_type(val cptr);
-val cptr_int(val n);
-val cptr_obj(val obj);
+val cptr_int(val n, val type_sym);
+val cptr_obj(val obj, val type_sym);
 val cptr_zap(val cptr);
 val cptr_free(val cptr);
 mem_t *cptr_get(val cptr);
diff --git a/txr.1 b/txr.1
index a0cbd8e8..14c60d98 100644
--- a/txr.1
+++ b/txr.1
@@ -53584,11 +53584,32 @@ function and is generally useful in conjunction with the Foreign Function
 Interface (FFI).  An arbitrary pointer emanating from a foreign function
 can be captured as a
 .code cptr
-value, which can be passed back into foreign code.
+value, which can be passed back into foreign code. For this purpose, there
+exits also a matching FFI type called
+.codn cptr .
+
+The
+.code cptr
+type supports a symbolic type tag, which defaults to
+.codn nil .
+The type tag plays a role in FFI. The FFI
+.code cptr
+type supports a tag attribute. When a
+.code cptr
+object is converted to a foreign pointer under the control of the FFI
+type, an that FFI type has a tag other than
+.codn nil ,
+the object's tag must exactly match that of the FFI type, or the conversion
+throws an error. In the reverse direction, when a foreign pointer is
+converted to a
+.code cptr
+object under control of the FFI
+.code cptr
+type, the object inherits the type tag from the FFI type.
 
 .coNP Function @ cptr-int
 .synb
-.mets (cptr-int << integer )
+.mets (cptr-int < integer <> [ type-symbol ])
 .syne
 .desc
 The
@@ -53610,9 +53631,17 @@ range; a portion of the range of
 .code bignum
 integers can denote pointers.
 
+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.
+
 .coNP Function @ cptr-obj
 .synb
-.mets (cptr-int << object )
+.mets (cptr-int < object <> [ type-symbol ])
 .syne
 .desc
 The
@@ -53632,6 +53661,14 @@ is simply stored in a new instance of
 .code cptr
 and returned.
 
+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.
+
 .coNP Function @ cptr-zap
 .synb
 .mets (cptr-zap << cptr )
@@ -54289,6 +54326,34 @@ macro. The
 type is useful for passing callbacks to foreign functions: Lisp functions
 which appear to be C functions to foreign code.
 
+.ccIP @ cptr
+The
+.code cptr
+type converts between a foreign pointer and a Lisp object of type
+.codn cptr .
+
+Lisp objects of type
+.code cptr
+are tagged with a symbolic tag, which may be
+.codn nil .
+
+The unparametrized
+.code cptr
+converts foreign pointers to
+.code cptr
+objects which are tagged with
+.codn nil .
+
+In the reverse direction, it converts
+.code cptr
+Lisp objects of type
+.code cptr
+to foreign pointer, without regard for their type tag.
+
+There is a parametrized version of the
+.code cptr
+FFI type, which provides a measure of type safety.
+
 .ccIP @ void
 The
 .code void
@@ -55052,6 +55117,51 @@ It is possible to create a
 view over a buffer, using
 .codn carray-buf .
 
+.meIP (cptr << type-sym )
+The parametrized
+.code cptr
+type is very similar to the unparametrized
+.codn cptr .
+It also converts between Lisp objects of type
+.code cptr
+and foreign pointers. However, it provides a measure of type safety.
+
+When a foreign pointer is converted to a Lisp object under control of the
+parametrized
+.codn cptr ,
+the resulting Lisp
+.code cptr
+object is tagged with the
+.meta type-sym
+symbol.
+
+In the reverse direction, when a Lisp
+.code cptr
+object is converted to the parametrized type, its type tag must match
+.metn type-sym ,
+or else the conversion fails with an error exception.
+
+Note that if
+.meta type-sym
+is specified as
+.codn nil ,
+then this is precisely equivalent to the unparametrized
+.code cptr
+which doesn't provides the above safety measure.
+
+Pointer type safety is useful, because FFI can be used to create bindings
+to large application programming interfaces (APIs) in which objects of
+many different kinds are referenced using pointer handles. The erroneous
+situation can occur that a FFI call passes a handle of one kind to a function
+expecting a different kind of handle. If all pointer handles are represented
+by a single
+.code cptr
+type, then such a situation proceeds without diagnosis.
+If handles of different types are all mapped to
+.code cptr
+types with different tags, the situation is intercepted and diagnosed
+with an error exception.
+
 .meIP (align < width << type )
 The FFI type operator
 .code align
-- 
cgit v1.2.3