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, 59 insertions, 36 deletions

diff --git a/hash.c b/hash.c
index 5413f65a..c6df9581 100644
--- a/hash.c
+++ b/hash.c
@@ -718,7 +718,8 @@ val make_hash(val weak_keys, val weak_vals, val equal_based)
 
 val make_similar_hash(val existing)
 {
-  struct hash *ex = coerce(struct hash *, cobj_handle(existing, hash_s));
+  val self = lit("make-similar-hash");
+  struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_s));
   struct hash *h = coerce(struct hash *, chk_malloc(sizeof *h));
   val mod = num_fast(256);
   val table = vector(mod, nil);
@@ -753,7 +754,8 @@ static val copy_hash_chain(val chain)
 
 val copy_hash(val existing)
 {
-  struct hash *ex = coerce(struct hash *, cobj_handle(existing, hash_s));
+  val self = lit("copy-hash");
+  struct hash *ex = coerce(struct hash *, cobj_handle(self, existing, hash_s));
   struct hash *h = coerce(struct hash *, chk_malloc(sizeof *h));
   val mod = num_fast(ex->modulus);
   val table = vector(mod, nil);
@@ -775,9 +777,9 @@ val copy_hash(val existing)
   return hash;
 }
 
-val gethash_c(val hash, val key, loc new_p)
+val gethash_c(val self, val hash, val key, loc new_p)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   int lim = hash_rec_limit;
   cnum hv = h->hops->hash_fun(key, &lim, h->seed);
   loc pchain = vecref_l(h->table, num_fast(hv % h->modulus));
@@ -788,9 +790,9 @@ val gethash_c(val hash, val key, loc new_p)
   return cell;
 }
 
-val gethash_e(val hash, val key)
+val gethash_e(val self, val hash, val key)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   int lim = hash_rec_limit;
   cnum hv = h->hops->hash_fun(key, &lim, h->seed);
   val chain = vecref(h->table, num_fast(hv % h->modulus));
@@ -799,19 +801,21 @@ val gethash_e(val hash, val key)
 
 val gethash(val hash, val key)
 {
-  val found = gethash_e(hash, key);
+  val self = lit("gethash");
+  val found = gethash_e(self, hash, key);
   return cdr(found);
 }
 
 val inhash(val hash, val key, val init)
 {
+  val self = lit("inhash");
   val cell;
 
   if (missingp(init)) {
-    gethash_f(hash, key, mkcloc(cell));
+    gethash_f(self, hash, key, mkcloc(cell));
   } else {
     val new_p;
-    cell = gethash_c(hash, key, mkcloc(new_p));
+    cell = gethash_c(self, hash, key, mkcloc(new_p));
     if (new_p)
       rplacd(cell, init);
   }
@@ -819,35 +823,39 @@ val inhash(val hash, val key, val init)
   return cell;
 }
 
-val gethash_f(val hash, val key, loc found)
+val gethash_f(val self, val hash, val key, loc found)
 {
-  set(found, gethash_e(hash, key));
+  set(found, gethash_e(self, hash, key));
   return cdr(deref(found));
 }
 
 val gethash_n(val hash, val key, val notfound_val)
 {
-  val existing = gethash_e(hash, key);
+  val self = lit("gethash-n");
+  val existing = gethash_e(self, hash, key);
   return if3(existing, cdr(existing), default_null_arg(notfound_val));
 }
 
 val sethash(val hash, val key, val value)
 {
+  val self = lit("sethash");
   val new_p;
-  rplacd(gethash_c(hash, key, mkcloc(new_p)), value);
+  rplacd(gethash_c(self, hash, key, mkcloc(new_p)), value);
   return value;
 }
 
 val pushhash(val hash, val key, val value)
 {
+  val self = lit("pushhash");
   val new_p;
-  mpush(value, gethash_l(hash, key, mkcloc(new_p)));
+  mpush(value, gethash_l(self, hash, key, mkcloc(new_p)));
   return new_p;
 }
 
 val remhash(val hash, val key)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  val self = lit("remhash");
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   int lim = hash_rec_limit;
   cnum hv = h->hops->hash_fun(key, &lim, h->seed);
   val *pchain = valptr(vecref_l(h->table, num_fast(hv % h->modulus)));
@@ -870,7 +878,8 @@ val remhash(val hash, val key)
 
 val clearhash(val hash)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  val self = lit("clearhash");
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   val mod = num_fast(256);
   val table = vector(mod, nil);
   cnum oldcount = h->count;
@@ -882,19 +891,22 @@ val clearhash(val hash)
 
 val hash_count(val hash)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  val self = lit("hash-count");
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   return num_fast(h->count);
 }
 
 val get_hash_userdata(val hash)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  val self = lit("get-hash-userdata");
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   return h->userdata;
 }
 
 val set_hash_userdata(val hash, val data)
 {
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  val self = lit("set-hash-userdata");
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   val olddata = h->userdata;
   set(mkloc(h->userdata, hash), data);
   return olddata;
@@ -923,8 +935,9 @@ static struct cobj_ops hash_iter_ops = cobj_ops_init(eq,
 
 val hash_begin(val hash)
 {
+  val self = lit("hash-begin");
   val hi_obj;
-  struct hash *h = coerce(struct hash *, cobj_handle(hash, hash_s));
+  struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_s));
   struct hash_iter *hi = coerce(struct hash_iter *, chk_malloc(sizeof *hi));
 
   hi->next = 0;
@@ -939,7 +952,9 @@ val hash_begin(val hash)
 
 val hash_next(val iter)
 {
-  struct hash_iter *hi = coerce(struct hash_iter *, cobj_handle(iter, hash_iter_s));
+  val self = lit("hash-next");
+  struct hash_iter *hi = coerce(struct hash_iter *,
+                                cobj_handle(self, iter, hash_iter_s));
   val hash = hi->hash;
   struct hash *h = hash ? coerce(struct hash *, hash->co.handle) : 0;
 
@@ -1238,7 +1253,7 @@ val group_reduce(val hash, val by_fun, val reduce_fun, val seq,
       val v = vecref(seq, num_fast(i));
       val key = funcall1(by_fun, v);
       val new_p;
-      val cell = gethash_c(hash, key, mkcloc(new_p));
+      val cell = gethash_c(self, hash, key, mkcloc(new_p));
 
       if (new_p)
         rplacd(cell, funcall2(reduce_fun, initval, v));
@@ -1250,7 +1265,7 @@ val group_reduce(val hash, val by_fun, val reduce_fun, val seq,
       val v = car(seq);
       val key = funcall1(by_fun, v);
       val new_p;
-      val cell = gethash_c(hash, key, mkcloc(new_p));
+      val cell = gethash_c(self, hash, key, mkcloc(new_p));
 
       if (new_p)
         rplacd(cell, funcall2(reduce_fun, initval, v));
@@ -1340,11 +1355,13 @@ val hash_alist(val hash)
 
 val hash_uni(val hash1, val hash2, val join_func)
 {
-  struct hash *h1 = coerce(struct hash *, cobj_handle(hash1, hash_s));
-  struct hash *h2 = coerce(struct hash *, cobj_handle(hash2, hash_s));
+  val self = lit("hash-uni");
+  struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
+  struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
 
   if (h1->hops != h2->hops)
-    uw_throwf(error_s, lit("hash-uni: ~a and ~a are incompatible hashes"), hash1, hash2, nao);
+    uw_throwf(error_s, lit("~a: ~s and ~s are incompatible hashes"),
+              self, hash1, hash2, nao);
 
   {
     val hout = make_similar_hash(hash1);
@@ -1364,7 +1381,7 @@ val hash_uni(val hash1, val hash2, val join_func)
       if (missingp(join_func)) {
         sethash(hout, car(entry), cdr(entry));
       } else {
-        loc ptr = gethash_l(hout, car(entry), nulloc);
+        loc ptr = gethash_l(self, hout, car(entry), nulloc);
         set(ptr, funcall2(join_func, cdr(entry), deref(ptr)));
       }
     }
@@ -1375,11 +1392,13 @@ val hash_uni(val hash1, val hash2, val join_func)
 
 val hash_diff(val hash1, val hash2)
 {
-  struct hash *h1 = coerce(struct hash *, cobj_handle(hash1, hash_s));
-  struct hash *h2 = coerce(struct hash *, cobj_handle(hash2, hash_s));
+  val self = lit("hash-diff");
+  struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
+  struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
 
   if (h1->hops != h2->hops)
-    uw_throwf(error_s, lit("hash-diff: ~a and ~a are incompatible hashes"), hash1, hash2, nao);
+    uw_throwf(error_s, lit("~a: ~s and ~a are incompatible hashes"),
+              self, hash1, hash2, nao);
 
   {
     val hout = copy_hash(hash1);
@@ -1398,11 +1417,13 @@ val hash_diff(val hash1, val hash2)
 
 val hash_isec(val hash1, val hash2, val join_func)
 {
-  struct hash *h1 = coerce(struct hash *, cobj_handle(hash1, hash_s));
-  struct hash *h2 = coerce(struct hash *, cobj_handle(hash2, hash_s));
+  val self = lit("hash-isec");
+  struct hash *h1 = coerce(struct hash *, cobj_handle(self, hash1, hash_s));
+  struct hash *h2 = coerce(struct hash *, cobj_handle(self, hash2, hash_s));
 
   if (h1->hops != h2->hops)
-    uw_throwf(error_s, lit("hash-uni: ~a and ~a are incompatible hashes"), hash1, hash2, nao);
+    uw_throwf(error_s, lit("~a: ~s and ~s are incompatible hashes"),
+              self, hash1, hash2, nao);
 
   {
     val hout = make_similar_hash(hash1);
@@ -1413,7 +1434,7 @@ val hash_isec(val hash1, val hash2, val join_func)
          entry = hash_next(hiter))
     {
       val found;
-      val data2 = gethash_f(hash2, car(entry), mkcloc(found));
+      val data2 = gethash_f(self, hash2, car(entry), mkcloc(found));
       if (found) {
         if (missingp(join_func))
           sethash(hout, car(entry), cdr(entry));
@@ -1460,15 +1481,17 @@ val hash_update(val hash, val fun)
 
 val hash_update_1(val hash, val key, val fun, val init)
 {
+  val self = lit("hash-update-1");
+
   if (missingp(init)) {
     val cons;
-    val data = gethash_f(hash, key, mkcloc(cons));
+    val data = gethash_f(self, hash, key, mkcloc(cons));
     if (cons)
       rplacd(cons, funcall1(fun, data));
     return data;
   } else {
     val new_p;
-    loc place = gethash_l(hash, key, mkcloc(new_p));
+    loc place = gethash_l(self, hash, key, mkcloc(new_p));
     if (new_p)
       set(place, funcall1(fun, init));
     else