Splitting cptr object into separate CPTR tag.

CPTR shares representation and a lot of implementation with
COBJ.  The COBJ class symbol is the CPTR type tag. There is no
hierarchy among CPTR tags. The nil tag is used for a modicum
of type looseness, so that we don't straitjacket ourselves
too much into this tag-based typing scheme.

All existing cptr objects are becoming CPTR, and all
get a nil tag, except for dlopen library handles, and
dlsym symbols, which are tagged as dlhandle and dlsym.

The FFI framework will support tag-declared cptr's. This will
help with safety. For instance, suppose an API has half a
dozen different kinds of opaque handles. If they are all just
cptr on the TXR Lisp side, it's easy to mix them up, passing
the wrong one to the wrong C function.

* lib.h (enum type): New enum member, CPTR.
(cptr_print_op, cptr_typed, cptrp, cptr_type, cptr_handle):
Declared.
(cptr_addr_of): Parameters added.

* lib.c (code2type): Map CPTR type code to cptr_s.
(equal): Handle CPTR objects. They are only equal to other
CPTR objects which have the same operations, and
are equal under the equal function of those operations.
(cptr_print_op): New function.
(cptr_ops): Use cptr_print_op rather than cobj_print_op.
(cptr_typed): New function.
(cptr): Use cptr_typed to make a cptr with tag nil,
rather than using cobj.
(cptrp, cptr_handle, cptr_type): New functions.
(cptr_get): Go through cptr_handle rather than cobj_handle.
(cptr_addr_of, cptr_zap, cptr_free): Use call to cptr_handle
rather than cobj_handle for the type checking side effect.
New parameters for type and parent function name.
(obj_print_impl): Handle CPTR with same case as COBJ.

* gc.c (finalize, mark_obj): Handle CPTR cases using
common code with COBJ.

* hash.c (equal_hash): Handle CPTR just like COBJ.

* eval.c (eval_init): Register cptrp and cptr-type intrinsic
functions.

* ffi.c (ffi_cptr_put, ffi_cptr_get, ffi_cptr_alloc): Use the
potentially type-safe cptr_handle, instead of cptr_get.
However, for an untagged cptr, there is no type safety because
tft->mtypes is nil. The argument can be any kind of cptr.

* sysif.c (dlhandle_s, dlsym_s): New symbol variables.
(cptr_dl_ops): Use cptr_print_op.
(dlopen_wrap, dlclose_wrap): Use typed cptr with
dlhandle as the type.
(dlsym_wrap, dlsym_checked, dlvsym_wrap, dlvsym_checked):
Recognize only a cptr of type dlhandle for the library.
Construct a typed cptr of type dlsym.
(sysif_init): Initialize dlhandle_s and dlsym_s.
Register dlsym function using dlsym_s.

1 files changed, 2 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 97004bd5..4e6766d0 100644
--- a/eval.c
+++ b/eval.c
@@ -6161,6 +6161,8 @@ void eval_init(void)
   reg_fun(intern(lit("cptr-obj"), user_package), func_n1(cptr_obj));
   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));
+  reg_fun(intern(lit("cptr-type"), user_package), func_n1(cptr_type));
   reg_varl(intern(lit("cptr-null"), user_package), cptr(0));
 
   eval_error_s = intern(lit("eval-error"), user_package);