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, 28 insertions, 23 deletions

diff --git a/parser.c b/parser.c
index 11557be8..1714d18b 100644
--- a/parser.c
+++ b/parser.c
@@ -169,14 +169,14 @@ val parser(val stream, val lineno)
   return parser;
 }
 
-static parser_t *get_parser_impl(val parser)
+static parser_t *get_parser_impl(val self, val parser)
 {
-  return coerce(parser_t *, cobj_handle(parser, parser_s));
+  return coerce(parser_t *, cobj_handle(self, parser, parser_s));
 }
 
 static val ensure_parser(val stream)
 {
-  val cell = gethash_c(stream_parser_hash, stream, nulloc);
+  val cell = gethash_c(lit("internal error"), stream_parser_hash, stream, nulloc);
   val pars = cdr(cell);
   if (pars)
     return pars;
@@ -391,7 +391,7 @@ void parser_circ_def(parser_t *p, val num, val expr)
 
   {
     val new_p = nil;
-    val cell = gethash_c(p->circ_ref_hash, num, mkcloc(new_p));
+    val cell = gethash_c(lit("parser"), p->circ_ref_hash, num, mkcloc(new_p));
 
     if (!new_p && cdr(cell) != unique_s)
       yyerrorf(p->scanner, lit("duplicate #~s= def"), num, nao);
@@ -520,7 +520,7 @@ val regex_parse(val string, val error_stream)
   return parser.syntax_tree;
 }
 
-static val lisp_parse_impl(val interactive, val rlcp_p, val source_in,
+static val lisp_parse_impl(val self, val interactive, val rlcp_p, val source_in,
                            val error_stream, val error_return_val, val name_in,
                            val lineno)
 {
@@ -535,7 +535,7 @@ static val lisp_parse_impl(val interactive, val rlcp_p, val source_in,
                      stream_get_prop(input_stream, name_k)));
   val parser = ensure_parser(input_stream);
   val saved_dyn = dyn_env;
-  parser_t *pi = get_parser_impl(parser);
+  parser_t *pi = get_parser_impl(self, parser);
   volatile val parsed = nil;
 
   if (rlcp_p)
@@ -547,7 +547,7 @@ static val lisp_parse_impl(val interactive, val rlcp_p, val source_in,
 
   error_stream = default_null_arg(error_stream);
   error_stream = if3(error_stream == t, std_output, or2(error_stream, std_null));
-  class_check (error_stream, stream_s);
+  class_check (self, error_stream, stream_s);
 
   if (lineno && !missingp(lineno))
     pi->lineno = c_num(lineno);
@@ -592,25 +592,28 @@ static val lisp_parse_impl(val interactive, val rlcp_p, val source_in,
 val lisp_parse(val source_in, val error_stream, val error_return_val,
                val name_in, val lineno)
 {
-  return lisp_parse_impl(nil, t, source_in, error_stream, error_return_val,
-                         name_in, lineno);
+  val self = lit("lisp-parse");
+  return lisp_parse_impl(self, nil, t, source_in, error_stream,
+                         error_return_val, name_in, lineno);
 }
 
 val nread(val source_in, val error_stream, val error_return_val,
           val name_in, val lineno)
 {
-  return lisp_parse_impl(nil, nil, source_in, error_stream, error_return_val,
-                         name_in, lineno);
+  val self = lit("nread");
+  return lisp_parse_impl(self, nil, nil, source_in, error_stream,
+                         error_return_val, name_in, lineno);
 }
 
 val iread(val source_in, val error_stream, val error_return_val,
           val name_in, val lineno)
 {
-  return lisp_parse_impl(t, nil, source_in, error_stream, error_return_val,
-                         name_in, lineno);
+  val self = lit("iread");
+  return lisp_parse_impl(self, t, nil, source_in, error_stream,
+                         error_return_val, name_in, lineno);
 }
 
-static val read_file_common(val stream, val error_stream, val compiled)
+static val read_file_common(val self, val stream, val error_stream, val compiled)
 {
   val error_val = gensym(nil);
   val name = stream_get_prop(stream, name_k);
@@ -619,7 +622,7 @@ static val read_file_common(val stream, val error_stream, val compiled)
   val parser = ensure_parser(stream);
 
   if (compiled) {
-    parser_t *pi = get_parser_impl(parser);
+    parser_t *pi = get_parser_impl(self, parser);
     pi->rec_source_loc = 0;
   }
 
@@ -668,14 +671,14 @@ static val read_file_common(val stream, val error_stream, val compiled)
   return t;
 }
 
-val read_eval_stream(val stream, val error_stream)
+val read_eval_stream(val self, val stream, val error_stream)
 {
-  return read_file_common(stream, error_stream, nil);
+  return read_file_common(self, stream, error_stream, nil);
 }
 
-val read_compiled_file(val stream, val error_stream)
+val read_compiled_file(val self, val stream, val error_stream)
 {
-  return read_file_common(stream, error_stream, t);
+  return read_file_common(self, stream, error_stream, t);
 }
 
 #if HAVE_TERMIOS
@@ -704,7 +707,7 @@ static void load_rcfile(val name)
     } else {
       val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env));
       env_vbind(dyn_env, load_path_s, resolved_name);
-      read_eval_stream(stream, std_output);
+      read_eval_stream(lit("listener"), stream, std_output);
       dyn_env = saved_dyn_env;
     }
   }
@@ -741,7 +744,7 @@ static val get_visible_syms(val package, int include_fallback)
       val fcell;
       val new_p;
       while ((fcell = hash_next(hiter))) {
-        val scell = gethash_c(symhash, car(fcell), mkcloc(new_p));
+        val scell = gethash_c(lit("listener"), symhash, car(fcell), mkcloc(new_p));
         if (new_p)
           rplacd(scell, cdr(fcell));
       }
@@ -1400,13 +1403,15 @@ val get_parser(val stream)
 
 val parser_errors(val parser)
 {
-  parser_t *p = coerce(parser_t *, cobj_handle(parser, parser_s));
+  val self = lit("parser-errors");
+  parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
   return num(p->errors);
 }
 
 val parser_eof(val parser)
 {
-  parser_t *p = coerce(parser_t *, cobj_handle(parser, parser_s));
+  val self = lit("parser-eof");
+  parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_s));
   return tnil(p->eof);
 }