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, 7 insertions, 2 deletions

diff --git a/lib.h b/lib.h
index 04440b39..bd5ddff8 100644
--- a/lib.h
+++ b/lib.h
@@ -59,7 +59,7 @@ typedef uint_ptr_t ucnum;
 
 typedef enum type {
   NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
-  STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV,
+  STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
   BGNUM, FLNUM, RNG, BUF, MAXTYPE = BUF
   /* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */
 } type_t;
@@ -253,6 +253,7 @@ struct cobj_ops {
  */
 
 void cobj_print_op(val, val, val, struct strm_ctx *);
+void cptr_print_op(val, val, val, struct strm_ctx *);
 val cobj_equal_handle_op(val left, val right);
 void cobj_destroy_stub_op(val);
 void cobj_destroy_free_op(val);
@@ -939,12 +940,16 @@ val cobjp(val obj);
 mem_t *cobj_handle(val cobj, val cls_sym);
 struct cobj_ops *cobj_ops(val cobj, val cls_sym);
 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_zap(val cptr);
 val cptr_free(val cptr);
 mem_t *cptr_get(val cptr);
-mem_t **cptr_addr_of(val cptr);
+mem_t *cptr_handle(val cobj, val type_sym, val self);
+mem_t **cptr_addr_of(val cptr, val type_sym, val self);
 val assoc(val key, val list);
 val assql(val key, val list);
 val rassoc(val key, val list);