Better identify functions that misuse COBJ-s and hashes.

In this patch, the cobj_handle, cobj_ops and variants of
gethash get an additional argument to identify the caller.
Many functions are updated to pass this down.

* buf.c (buf_strm): Pass self name to cobj_handle.

* eval.c (env_fbind, env_vbind, rt_defvarl, me_case): Pass
self name to gethash_c or gethash_e.
(load): Pass self name to read_eval_stream and
read_compiled_file.
(reg_symacro): Pass situation-identifying string to gethash_c.

* ffi.c (ffi_type_struct_checked, ffi_closure_struct_checked,
ffi_call_desc_checked, uni_struct_checked):
Take self name parameter, and pass down to cobj_handle.
(ffi_get_type, ffi_get_lisp_type): Take self name and pass
down to ffi_type_struct_checked.
(union_get_ptr): Take self name and pass to
uni_struct_checked.
(ffi_union_in, ffi_union_put): Pass self name to union_get_ptr.
(ffi_type_compile): Pass self name to ffi_get_lisp_type.
(ffi_make_call_desc): Pass self name to
ffi_type_struct_checked, ffi_get_type and
ffi_call_desc_checked.
(ffi_make_closure): Pass self name to ffi_call_desc_checked.
(ffi_closure_get_fptr): Take self name, pass to
ffi_closure_struct_checked.
(ffi_typedef, ffi_size, ffi_alignof, ffi_offsetof,
ffi_arraysize, ffi_elemsize, ffi_elemtype, ffi_put_into,
ffi_put, ffi_in, ffi_get, ffi_out, make_carray): Pass self
name to ffi_closure_struct_checked.
(carray_struct_checked): Take self name, pass to cobj_handle.
(carray_set_length, carray_dup, carray_own, carray_free,
carray_type, length_carray, copy_carray, carray_ptr,
buf_carray, vec_carray, list_carray, carray_ref,
carray_refset, carray_sub, carray_replace, carray_get_common,
carray_put_common, unum_carray, num_carray, put_carray,
fill_carray): Pass self name to carray_struct_checked.
(carray_blank, carray_buf, carray_cptr): Pass self name
ffi_type_struct_checked.
(carray_pun): Pass self name to carray_struct_checked and
ffi_type_struct_checked.
(make_union): Pass self name to ffi_type_struct_checked.
(union_members, union_get, union_put, union_in, union_out):
Pass self name to uni_struct_checked.
(make_zstruct, zero_fill, put_obj, get_obj, fill_obj): Pass
self-name to ffi_type_struct_checked.

* ffi.h (ffi_closure_get_fptr, union_get_ptr): Declarations
updated.

* filter.c (trie_add): Pass self-name to gethash_l.

* hash.c (make_similar_hash, copy_hash, hash_count,
get_hash_userdata, set_hash_userdata, hash_begin, hash_next,
hash_uni, hash_diff, hash_isec): Pass self name
to cobj_handle.
(gethash_c, gethash_e): Take self name parameter and pass down
to cobj_handle.
(gethash_f): Take self parameter and pass down to gethash_e.
(gethash, inhash, gethash_n, sethash, pushhash, remhash,
clearhash, hash_update_1): Pass self name to gethash_e or gethash_c.

* hash.h (gethash_c, gethash_e, gethash_f): Declarations
updated.
(gethash_l): Take self name, and pass down to gethash_c.

* lib.c (class_check): Take self name parameter and use in
type mismatch diagnostic.
(use_sym, unuse_sym, symbol_needs_prefix, find_symbol,
intern, unintern, intern_fallback, unique, in, sel,
obj_print_impl, populate_obj_hash, obj_hash_merge): Pass self
name to gethash_f or gethash_l.
(symbol_visible, obj_init): Pass situation-identifying string
to gethash_e.
(cobj_handle, cobj_ops): Take self name parameter and pass
down to class_check.

* lib.h (class_check, cobj_handle, cobj_ops): Declarations
updated.

* match.c (v_load): Pass self name to read_compiled_file and
read_eval_stream.

* parser.c (get_parser_impl): Take self name and pass to
cobj_handle.
(ensure_parser): Pass situation-identifying string to
gethash_c.
(parser_circ_def): Pass self-name to gethash_c.
(lisp_parser_impl): Pass self name to get_parser_impl and
class_check.
(lisp_parse, nread, iread): Pass self-name to lisp_parser_impl.
(read_file_common): Take self name parameter and pass down to
get_parser_impl.
(read_eval_stream, read_compiled_file): Take self name and
pass down to read_file_common.
(load_rcfile): Pass situation-identifying string to
read_eval_streem.
(get_visible_syms): Pass situation-identifying string to
gethash_c.
(parser_errors, parser_eof): Pass self name to cobj_handle.

* parser.h (read_eval_stream, read_compiled_file):
Declarations updated.

* parser.y (rlset): Pass self name to gethash_c.

* rand.c (make_random_state, random_state_get_vec,l
random_fixnum, random_float): Pass self name to cobj_handle.

* regex.c (regex_source, regex_print, regex_run): Pass
self-name to cobj_handle.
(regex_machine_init): Take self name param and pass to
cobj_handle.
(search_regex, match_regex, match_regex_right,
regex_prefix_match, read_until_match): Pass self-name to
regex_machine_init.

* stream.c (stdio_get_fd): Pass self name to cobj_handle.
(generic_get_line): Get COBJ operations via unsafe, diret
object access rather than cobj_ops.
(set_mode_props): Get object handle via unsafe, direct object
access.
(stream_fd, sock_family, sock_type, sock_peer, set_sock_peer,
get_string_from_stream, get_list_from_stream, stream_set_prop,
stream_get_prop, close_stream, get_error, get_error_str,
clear_error, get_line, get_char, get_byte, unget_char,
unget_byte, put_buf, fill_buf, put_string, put_char, put_byte,
flush_stream, seek_stream, truncate_stream, get_indent_mode,
test_set_indent_mode, set_indent_mode, get_indent, set_indent,
inc_indent, width_check, force_break, get_set_ctx, get_ctx):
Pass self name to cobj_ops.
(make_delegate_stream): Take self name parameter, pass down to
cobj_ops.
(record_adapter): Pass self name down to make_delegate_stream.
(format): Pass self name to class_check.

* struct.c (stype_handle): Pass self name to cobj_handle.
(make_struct_type): Pass self name to class_check.

* txr.c (read_eval_stream_noerr): Take self name parameter,
pass to read_eval_stream.
(txr_main): Pass istuation-identifying string to
read_compiled_file and read_eval_stream_noerr.

* unwind.c (revive_cont): Pass self-name to cobj_handle.

* vm.c (vm_desc_struct): Take self name parameter, pass to
cobj_handle.
(vm_desc_nlevels, vm_desc_nregs, vm_desc_bytecode,
vm_desc_datavec, vm_desc_symvec, vm_execute_toplevel,
vm_execute_closure, vm_closure_entry): Pass self name to
vm_desc_struct.
(vm_closure_struct): Take self name parameter, pass to
cobj_handle.

1 files changed, 96 insertions, 83 deletions

diff --git a/ffi.c b/ffi.c
index 93d6a2a2..27db9a88 100644
--- a/ffi.c
+++ b/ffi.c
@@ -194,22 +194,22 @@ static struct txr_ffi_type *ffi_type_struct(val obj)
   return coerce(struct txr_ffi_type *, obj->co.handle);
 }
 
-static struct txr_ffi_type *ffi_type_struct_checked(val obj)
+static struct txr_ffi_type *ffi_type_struct_checked(val self, val obj)
 {
-  return coerce(struct txr_ffi_type *, cobj_handle(obj, ffi_type_s));
+  return coerce(struct txr_ffi_type *, cobj_handle(self, obj, ffi_type_s));
 }
 
 #if HAVE_LIBFFI
-static ffi_type *ffi_get_type(val obj)
+static ffi_type *ffi_get_type(val self, val obj)
 {
-  struct txr_ffi_type *tffi = ffi_type_struct_checked(obj);
+  struct txr_ffi_type *tffi = ffi_type_struct_checked(self, obj);
   return tffi->ft;
 }
 #endif
 
-static val ffi_get_lisp_type(val obj)
+static val ffi_get_lisp_type(val self, val obj)
 {
-  struct txr_ffi_type *tffi = ffi_type_struct_checked(obj);
+  struct txr_ffi_type *tffi = ffi_type_struct_checked(self, obj);
   return tffi->lt;
 }
 
@@ -328,9 +328,9 @@ static struct txr_ffi_closure *ffi_closure_struct(val obj)
   return coerce(struct txr_ffi_closure *, obj->co.handle);
 }
 
-static struct txr_ffi_closure *ffi_closure_struct_checked(val obj)
+static struct txr_ffi_closure *ffi_closure_struct_checked(val self, val obj)
 {
-  return coerce(struct txr_ffi_closure *, cobj_handle(obj, ffi_closure_s));
+  return coerce(struct txr_ffi_closure *, cobj_handle(self, obj, ffi_closure_s));
 }
 
 static void ffi_closure_print_op(val obj, val out,
@@ -2690,7 +2690,7 @@ static val ffi_union_in(struct txr_ffi_type *tft, int copy, mem_t *src,
     if (uni == nil) {
       uni = make_union_tft(src, tft);
     } else {
-      mem_t *ptr = union_get_ptr(uni);
+      mem_t *ptr = union_get_ptr(self, uni);
       memcpy(ptr, src, tft->size);
     }
   }
@@ -2701,7 +2701,7 @@ static val ffi_union_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 static void ffi_union_put(struct txr_ffi_type *tft, val uni,
                           mem_t *dst, val self)
 {
-  mem_t *ptr = union_get_ptr(uni);
+  mem_t *ptr = union_get_ptr(self, uni);
   memcpy(dst, ptr, tft->size);
 }
 
@@ -3351,7 +3351,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_in_put, ffi_ptr_get,
                                    ffi_ptr_in_in, ffi_ptr_in_out,
                                    ffi_ptr_in_release, target_type);
@@ -3359,7 +3359,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_in_put, ffi_ptr_d_get,
                                    ffi_ptr_in_d_in, ffi_ptr_in_out,
                                    ffi_ptr_in_release, target_type);
@@ -3367,7 +3367,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_out_put, ffi_ptr_get,
                                    ffi_ptr_out_in, ffi_ptr_out_out,
                                    ffi_simple_release, target_type);
@@ -3375,7 +3375,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_out_null_put, ffi_ptr_d_get,
                                    ffi_ptr_out_in, ffi_ptr_out_out,
                                    0, target_type);
@@ -3383,7 +3383,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_in_put, ffi_ptr_get,
                                    ffi_ptr_out_in, ffi_ptr_out_out,
                                    ffi_ptr_in_release, target_type);
@@ -3391,7 +3391,7 @@ val ffi_type_compile(val syntax)
       val target_type = ffi_type_compile(cadr(syntax));
       if (cddr(syntax))
         goto excess;
-      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(target_type),
+      return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
                                    ffi_ptr_out_null_put, ffi_ptr_get,
                                    ffi_ptr_out_s_in, ffi_ptr_out_out,
                                    0, target_type);
@@ -4059,9 +4059,10 @@ static struct txr_ffi_call_desc *ffi_call_desc(val obj)
   return coerce(struct txr_ffi_call_desc *, obj->co.handle);
 }
 
-static struct txr_ffi_call_desc *ffi_call_desc_checked(val obj)
+static struct txr_ffi_call_desc *ffi_call_desc_checked(val self, val obj)
 {
-  return coerce(struct txr_ffi_call_desc *, cobj_handle(obj, ffi_call_desc_s));
+  return coerce(struct txr_ffi_call_desc *, cobj_handle(self, obj,
+                                                        ffi_call_desc_s));
 }
 
 static void ffi_call_desc_print_op(val obj, val out,
@@ -4115,7 +4116,7 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
 
   for (i = 0; i < nt; i++) {
     val type = pop(&argtypes);
-    struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+    struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
     if (tft->size == 0)
       uw_throwf(error_s, lit("~a: can't pass type ~s by value"),
                 self, type, nao);
@@ -4126,7 +4127,7 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
   }
 
   {
-    struct txr_ffi_type *tft = ffi_type_struct_checked(rettype);
+    struct txr_ffi_type *tft = ffi_type_struct_checked(self, rettype);
     if (tft->size == 0 && tft->ft != &ffi_type_void)
       uw_throwf(error_s, lit("~a: can't return type ~s by value"),
                 self, rettype, nao);
@@ -4137,10 +4138,10 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
 
   if (tfcd->variadic)
     ffis = ffi_prep_cif_var(&tfcd->cif, FFI_DEFAULT_ABI, nf, nt,
-                            ffi_get_type(rettype), args);
+                            ffi_get_type(self, rettype), args);
   else
     ffis = ffi_prep_cif(&tfcd->cif, FFI_DEFAULT_ABI, nt,
-                        ffi_get_type(rettype), args);
+                        ffi_get_type(self, rettype), args);
 
   if (ffis != FFI_OK)
     uw_throwf(error_s, lit("~a: ffi_prep_cif failed: ~s"),
@@ -4152,7 +4153,7 @@ val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
 val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args)
 {
   val self = lit("ffi-call");
-  struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(ffi_call_desc);
+  struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, ffi_call_desc);
   mem_t *fp = cptr_get(fptr);
   cnum n = tfcd->ntotal;
   void **values = convert(void **, alloca(sizeof *values * tfcd->ntotal));
@@ -4347,7 +4348,7 @@ val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in)
   val self = lit("ffi-make-closure");
   struct txr_ffi_closure *tfcl = coerce(struct txr_ffi_closure *,
                                         chk_calloc(1, sizeof *tfcl));
-  struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(call_desc);
+  struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, call_desc);
   val obj = cobj(coerce(mem_t *, tfcl), ffi_closure_s, &ffi_closure_ops);
   val safe_p = default_arg(safe_p_in, t);
   ffi_status ffis = FFI_OK;
@@ -4378,9 +4379,9 @@ val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in)
   return obj;
 }
 
-mem_t *ffi_closure_get_fptr(val closure)
+mem_t *ffi_closure_get_fptr(val self, val closure)
 {
-  struct txr_ffi_closure *tfcl = ffi_closure_struct_checked(closure);
+  struct txr_ffi_closure *tfcl = ffi_closure_struct_checked(self, closure);
   return tfcl->fptr;
 }
 
@@ -4389,7 +4390,7 @@ mem_t *ffi_closure_get_fptr(val closure)
 val ffi_typedef(val name, val type)
 {
   val self = lit("ffi-typedef");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   if (bitfield_syntax_p(tft->syntax))
     uw_throwf(error_s, lit("~a: cannot create a typedef for bitfield type"),
               self, nao);
@@ -4399,7 +4400,7 @@ val ffi_typedef(val name, val type)
 val ffi_size(val type)
 {
   val self = lit("ffi-size");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   if (bitfield_syntax_p(tft->syntax))
     uw_throwf(error_s, lit("~a: bitfield type ~s has no size"),
               self, type, nao);
@@ -4409,7 +4410,7 @@ val ffi_size(val type)
 val ffi_alignof(val type)
 {
   val self = lit("ffi-alignof");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   if (bitfield_syntax_p(tft->syntax))
     uw_throwf(error_s, lit("~a: bitfield type ~s has no alignment"),
               self, type, nao);
@@ -4419,7 +4420,7 @@ val ffi_alignof(val type)
 val ffi_offsetof(val type, val memb)
 {
   val self = lit("ffi-offsetof");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum i;
 
   if (!tft->memb)
@@ -4442,7 +4443,7 @@ val ffi_offsetof(val type, val memb)
 val ffi_arraysize(val type)
 {
   val self = lit("ffi-put-into");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   if (!tft->eltype)
     uw_throwf(error_s, lit("~a: ~s isn't an array"), self, type, nao);
   return num(tft->nelem);
@@ -4451,7 +4452,7 @@ val ffi_arraysize(val type)
 val ffi_elemsize(val type)
 {
   val self = lit("ffi-elemsize");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   if (!tft->eltype) {
     uw_throwf(error_s, lit("~a: ~s isn't an array or pointer"),
               self, type, nao);
@@ -4464,7 +4465,7 @@ val ffi_elemsize(val type)
 val ffi_elemtype(val type)
 {
   val self = lit("ffi-elemtype");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   val eltype = tft->eltype;
 
   if (!eltype) {
@@ -4478,7 +4479,7 @@ val ffi_elemtype(val type)
 val ffi_put_into(val dstbuf, val obj, val type, val offset_in)
 {
   val self = lit("ffi-put-into");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   mem_t *dst = buf_get(dstbuf, self);
   val offset = default_arg(offset_in, zero);
   cnum offsn = c_num(offset);
@@ -4496,7 +4497,7 @@ val ffi_put_into(val dstbuf, val obj, val type, val offset_in)
 val ffi_put(val obj, val type)
 {
   val self = lit("ffi-put");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   val buf = make_buf(num_fast(tft->size), zero, nil);
   mem_t *dst = buf_get(buf, self);
   tft->put(tft, obj, dst, self);
@@ -4506,7 +4507,7 @@ val ffi_put(val obj, val type)
 val ffi_in(val srcbuf, val obj, val type, val copy_p, val offset_in)
 {
   val self = lit("ffi-in");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   mem_t *src = buf_get(srcbuf, self);
   val offset = default_arg(offset_in, zero);
   cnum offsn = c_num(offset);
@@ -4527,7 +4528,7 @@ val ffi_in(val srcbuf, val obj, val type, val copy_p, val offset_in)
 val ffi_get(val srcbuf, val type, val offset_in)
 {
   val self = lit("ffi-get");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   mem_t *src = buf_get(srcbuf, self);
   val offset = default_arg(offset_in, zero);
   cnum offsn = c_num(offset);
@@ -4544,7 +4545,7 @@ val ffi_get(val srcbuf, val type, val offset_in)
 val ffi_out(val dstbuf, val obj, val type, val copy_p, val offset_in)
 {
   val self = lit("ffi-out");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   mem_t *dst = buf_get(dstbuf, self);
   val offset = default_arg(offset_in, zero);
   cnum offsn = c_num(offset);
@@ -4577,9 +4578,9 @@ static struct carray *carray_struct(val carray)
   return coerce(struct carray*, carray->co.handle);
 }
 
-static struct carray *carray_struct_checked(val carray)
+static struct carray *carray_struct_checked(val self, val carray)
 {
-  return coerce(struct carray*, cobj_handle(carray, carray_s));
+  return coerce(struct carray*, cobj_handle(self, carray, carray_s));
 }
 
 static void carray_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
@@ -4624,10 +4625,11 @@ static struct cobj_ops carray_owned_ops =
 
 val make_carray(val type, mem_t *data, cnum nelem, val ref, cnum offs)
 {
+  val self = lit("make-carray");
   struct carray *scry = coerce(struct carray *, chk_malloc(sizeof *scry));
   val obj;
   scry->eltype = nil;
-  scry->eltft = ffi_type_struct_checked(type);
+  scry->eltft = ffi_type_struct_checked(self, type);
   scry->data = data;
   scry->nelem = nelem;
   scry->ref = nil;
@@ -4646,8 +4648,8 @@ val carrayp(val obj)
 
 val carray_set_length(val carray, val nelem)
 {
-  struct carray *scry = carray_struct_checked(carray);
   val self = lit("carray-set-length");
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum nel = c_num(nelem);
 
   if (carray->co.ops == &carray_owned_ops)
@@ -4667,7 +4669,7 @@ val carray_set_length(val carray, val nelem)
 val carray_dup(val carray)
 {
   val self = lit("carray-dup");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
 
   if (carray->co.ops == &carray_owned_ops) {
     return nil;
@@ -4694,7 +4696,7 @@ val carray_dup(val carray)
 val carray_own(val carray)
 {
   val self = lit("carray-own");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   if (scry->ref)
     uw_throwf(error_s, lit("~a: cannot own buffer belonging to ~s"),
               self, scry->ref, nao);
@@ -4705,7 +4707,7 @@ val carray_own(val carray)
 val carray_free(val carray)
 {
   val self = lit("carray-free");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
 
   if (carray->co.ops == &carray_owned_ops) {
     free(scry->data);
@@ -4721,19 +4723,22 @@ val carray_free(val carray)
 
 val carray_type(val carray)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("carray-type");
+  struct carray *scry = carray_struct_checked(self, carray);
   return scry->eltype;
 }
 
 val length_carray(val carray)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("length-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
   return if3(scry->nelem < 0, nil, num(scry->nelem));
 }
 
 val copy_carray(val carray)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("copy-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
   val copy = make_carray(scry->eltype, scry->data, scry->nelem, nil, 0);
   carray_dup(copy);
   return copy;
@@ -4741,7 +4746,7 @@ val copy_carray(val carray)
 
 mem_t *carray_ptr(val carray, val type, val self)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   if (scry->eltype != type)
     uw_throwf(error_s, lit("~a: ~s is not of element type ~!~s"),
               self, carray, type, nao);
@@ -4785,7 +4790,7 @@ val carray_blank(val nelem, val type)
 {
   val self = lit("carray-blank");
   cnum nel = c_num(nelem);
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 
   if (nel < 0) {
     uw_throwf(error_s, lit("~a: negative array size"), self, nao);
@@ -4804,7 +4809,7 @@ val carray_buf(val buf, val type, val offs_in)
   val offs = default_arg_strict(offs_in, zero);
   cnum offsn = c_num(offs);
   cnum blen = c_num(minus(length_buf(buf), offs));
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum nelem = if3(tft->size, blen / tft->size, 0);
   if (offsn < 0)
     uw_throwf(error_s,
@@ -4824,7 +4829,7 @@ val carray_buf(val buf, val type, val offs_in)
 val carray_buf_sync(val carray)
 {
   val self = lit("carray-buf-sync");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   val buf = scry->ref;
   mem_t *data = buf_get(buf, self);
   cnum blen = c_num(minus(length_buf(buf), num(scry->offs)));
@@ -4840,7 +4845,8 @@ val carray_buf_sync(val carray)
 
 val buf_carray(val carray)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("buf-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
   struct txr_ffi_type *etft = scry->eltft;
   cnum bytes = scry->nelem * etft->size;
   return  make_duplicate_buf(num(bytes), scry->data);
@@ -4848,16 +4854,18 @@ val buf_carray(val carray)
 
 val carray_cptr(val cptr, val type, val len)
 {
+  val self = lit("carray-cptr");
   mem_t *data = cptr_get(cptr);
   cnum nelem = c_num(default_arg(len, negone));
-  (void) ffi_type_struct_checked(type);
+  (void) ffi_type_struct_checked(self, type);
   return make_carray(type, data, nelem, nil, 0);
 }
 
 val vec_carray(val carray, val null_term_p)
 {
+  val self = lit("vec-carray");
   val nt_p = default_null_arg(null_term_p);
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum i, l = if3(nt_p, scry->nelem - 1, scry->nelem);
   val vec = vector(num(l), nil);
   for (i = 0; i < l; i++) {
@@ -4870,8 +4878,9 @@ val vec_carray(val carray, val null_term_p)
 
 val list_carray(val carray, val null_term_p)
 {
+  val self = lit("list-carray");
   val nt_p = default_null_arg(null_term_p);
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum i, l = if3(nt_p, scry->nelem - 1, scry->nelem);
   list_collect_decl (list, ptail);
   for (i = 0; i < l; i++) {
@@ -4885,7 +4894,7 @@ val list_carray(val carray, val null_term_p)
 val carray_ref(val carray, val idx)
 {
   val self = lit("carray-ref");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum ix = c_num(idx);
 
   if (ix < 0)
@@ -4906,7 +4915,7 @@ val carray_ref(val carray, val idx)
 val carray_refset(val carray, val idx, val newval)
 {
   val self = lit("carray-refset");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum ix = c_num(idx);
 
   if (ix < 0 || (scry->nelem >= 0 && ix >= scry->nelem)) {
@@ -4924,7 +4933,8 @@ val carray_refset(val carray, val idx, val newval)
 
 val carray_sub(val carray, val from, val to)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("carray-sub");
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum ln = scry->nelem;
   val len = num(ln);
 
@@ -4967,7 +4977,7 @@ val carray_sub(val carray, val from, val to)
 val carray_replace(val carray, val values, val from, val to)
 {
   val self = lit("carray-replace");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   cnum ln = scry->nelem;
   val len = num(ln);
   val vlen = length(values);
@@ -5080,7 +5090,7 @@ static void carray_ensure_artype(val carray, struct carray *scry, val self)
 
 static val carray_get_common(val carray, val self, unsigned null_term)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
 
   carray_ensure_artype(carray, scry, self);
 
@@ -5093,7 +5103,7 @@ static val carray_get_common(val carray, val self, unsigned null_term)
 
 static void carray_put_common(val carray, val seq, val self, unsigned null_term)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
 
   carray_ensure_artype(carray, scry, self);
 
@@ -5133,8 +5143,8 @@ val carray_putz(val carray, val seq)
 val carray_pun(val carray, val type)
 {
   val self = lit("carray-pun");
-  struct carray *scry = carray_struct_checked(carray);
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct carray *scry = carray_struct_checked(self, carray);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum len = scry->nelem;
   cnum elsize = scry->eltft->size;
   cnum size = (ucnum) len * (ucnum) elsize;
@@ -5232,7 +5242,7 @@ val carray_num(val num, val eltype_in)
 val unum_carray(val carray)
 {
   val self = lit("unum-carray");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   struct txr_ffi_type *etft = scry->eltft;
   ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
   val ubn = make_bignum();
@@ -5245,7 +5255,7 @@ val unum_carray(val carray)
 val num_carray(val carray)
 {
   val self = lit("num-carray");
-  struct carray *scry = carray_struct_checked(carray);
+  struct carray *scry = carray_struct_checked(self, carray);
   struct txr_ffi_type *etft = scry->eltft;
   ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
   ucnum bits = size * 8;
@@ -5258,7 +5268,8 @@ val num_carray(val carray)
 
 val put_carray(val carray, val offs, val stream)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("put-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
   struct txr_ffi_type *etft = scry->eltft;
   ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
   val buf = make_borrowed_buf(unum(size), scry->data);
@@ -5270,7 +5281,8 @@ val put_carray(val carray, val offs, val stream)
 
 val fill_carray(val carray, val offs, val stream)
 {
-  struct carray *scry = carray_struct_checked(carray);
+  val self = lit("fill-carray");
+  struct carray *scry = carray_struct_checked(self, carray);
   struct txr_ffi_type *etft = scry->eltft;
   ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
   val buf = make_borrowed_buf(unum(size), scry->data);
@@ -5290,9 +5302,9 @@ static struct uni *uni_struct(val obj)
   return coerce(struct uni *, obj->co.handle);
 }
 
-static struct uni *uni_struct_checked(val obj)
+static struct uni *uni_struct_checked(val self, val obj)
 {
-  return coerce(struct uni *, cobj_handle(obj, union_s));
+  return coerce(struct uni *, cobj_handle(self, obj, union_s));
 }
 
 static void union_destroy_op(val obj)
@@ -5331,16 +5343,16 @@ static val make_union_tft(mem_t *data_in, struct txr_ffi_type *tft)
   return make_union_common(data, tft);
 }
 
-mem_t *union_get_ptr(val uni)
+mem_t *union_get_ptr(val self, val uni)
 {
-  struct uni *us = uni_struct_checked(uni);
+  struct uni *us = uni_struct_checked(self, uni);
   return us->data;
 }
 
 val make_union(val type, val init, val memb)
 {
   val self = lit("make-union");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   mem_t *data = chk_calloc(1, tft->size);
   val uni = make_union_common(data, tft);
   if (!missingp(init)) {
@@ -5355,7 +5367,8 @@ val make_union(val type, val init, val memb)
 
 val union_members(val uni)
 {
-  struct uni *us = uni_struct_checked(uni);
+  val self = lit("union-members");
+  struct uni *us = uni_struct_checked(self, uni);
   struct txr_ffi_type *tft = us->tft;
   cnum i;
   list_collect_decl (out, ptail);
@@ -5369,7 +5382,7 @@ val union_members(val uni)
 val union_get(val uni, val memb)
 {
   val self = lit("union-get");
-  struct uni *us = uni_struct_checked(uni);
+  struct uni *us = uni_struct_checked(self, uni);
   struct txr_ffi_type *tft = us->tft;
   struct txr_ffi_type *mtft = ffi_find_memb(tft, memb);
   if (mtft == 0)
@@ -5380,7 +5393,7 @@ val union_get(val uni, val memb)
 val union_put(val uni, val memb, val newval)
 {
   val self = lit("union-put");
-  struct uni *us = uni_struct_checked(uni);
+  struct uni *us = uni_struct_checked(self, uni);
   struct txr_ffi_type *tft = us->tft;
   struct txr_ffi_type *mtft = ffi_find_memb(tft, memb);
   if (mtft == 0)
@@ -5392,7 +5405,7 @@ val union_put(val uni, val memb, val newval)
 val union_in(val uni, val memb, val memb_obj)
 {
   val self = lit("union-in");
-  struct uni *us = uni_struct_checked(uni);
+  struct uni *us = uni_struct_checked(self, uni);
   struct txr_ffi_type *tft = us->tft;
   struct txr_ffi_type *mtft = ffi_find_memb(tft, memb);
   if (mtft == 0)
@@ -5403,7 +5416,7 @@ val union_in(val uni, val memb, val memb_obj)
 val union_out(val uni, val memb, val memb_obj)
 {
   val self = lit("union-out");
-  struct uni *us = uni_struct_checked(uni);
+  struct uni *us = uni_struct_checked(self, uni);
   struct txr_ffi_type *tft = us->tft;
   struct txr_ffi_type *mtft = ffi_find_memb(tft, memb);
   if (mtft == 0)
@@ -5415,7 +5428,7 @@ val union_out(val uni, val memb, val memb_obj)
 val make_zstruct(val type, struct args *args)
 {
   val self = lit("make-zstruct");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   val pairs = args_get_list(args);
   args_decl(ms_args, 0);
   val strct = make_struct(tft->lt, nil, ms_args);
@@ -5460,7 +5473,7 @@ val make_zstruct(val type, struct args *args)
 val zero_fill(val type, val obj)
 {
   val self = lit("zero-fill");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum size = tft->size;
   int need_free = (size >= 1024);
   mem_t *buf = if3(need_free, chk_calloc(1, size), coerce(mem_t *, zalloca(size)));
@@ -5492,7 +5505,7 @@ val zero_fill(val type, val obj)
 val put_obj(val obj, val type, val stream)
 {
   val self = lit("put-obj");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum size = tft->size;
   val len = num(size);
   mem_t *data = coerce(mem_t *, zalloca(size));
@@ -5506,7 +5519,7 @@ val put_obj(val obj, val type, val stream)
 val get_obj(val type, val stream)
 {
   val self = lit("get-obj");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum size = tft->size;
   val len = num(size);
   mem_t *data = coerce(mem_t *, zalloca(size));
@@ -5520,7 +5533,7 @@ val get_obj(val type, val stream)
 val fill_obj(val obj, val type, val stream)
 {
   val self = lit("fill-obj");
-  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
   cnum size = tft->size;
   val len = num(size);
   mem_t *data = coerce(mem_t *, zalloca(size));