diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-11-07 07:34:42 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-11-07 07:34:42 -0800 |
| commit | fdf3fd788efb143631099c2e16636e27b3241ac3 (patch) | |
| tree | 79f496a051aa29faf16d7530ca601adb3ad941a4 | |
| parent | 19dc84bcf137ed742e824e2b86e403b9f53031fb (diff) | |
| download | txr-fdf3fd788efb143631099c2e16636e27b3241ac3.tar.gz txr-fdf3fd788efb143631099c2e16636e27b3241ac3.tar.bz2 txr-fdf3fd788efb143631099c2e16636e27b3241ac3.zip | |
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.
| -rw-r--r-- | buf.c | 2 | ||||
| -rw-r--r-- | eval.c | 34 | ||||
| -rw-r--r-- | ffi.c | 179 | ||||
| -rw-r--r-- | ffi.h | 4 | ||||
| -rw-r--r-- | filter.c | 2 | ||||
| -rw-r--r-- | hash.c | 95 | ||||
| -rw-r--r-- | hash.h | 10 | ||||
| -rw-r--r-- | lib.c | 86 | ||||
| -rw-r--r-- | lib.h | 6 | ||||
| -rw-r--r-- | match.c | 5 | ||||
| -rw-r--r-- | parser.c | 51 | ||||
| -rw-r--r-- | parser.h | 4 | ||||
| -rw-r--r-- | parser.y | 2 | ||||
| -rw-r--r-- | rand.c | 19 | ||||
| -rw-r--r-- | regex.c | 29 | ||||
| -rw-r--r-- | stream.c | 165 | ||||
| -rw-r--r-- | struct.c | 5 | ||||
| -rw-r--r-- | txr.c | 9 | ||||
| -rw-r--r-- | unwind.c | 3 | ||||
| -rw-r--r-- | vm.c | 35 |
20 files changed, 445 insertions, 300 deletions
@@ -891,7 +891,7 @@ static struct strm_ops buf_strm_ops = static struct buf_strm *buf_strm(val stream, val self) { struct buf_strm *s = coerce(struct buf_strm *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); type_assert (stream->co.ops == &buf_strm_ops.cobj_ops, (lit("~a: ~a is not a buffer stream"), self, stream, nao)); @@ -152,13 +152,15 @@ static val make_env_intrinsic(val vbindings, val fbindings, val up_env) val env_fbind(val env, val sym, val fun) { + val self = lit("env-fbind"); + if (env) { val cell; - type_check(lit("env-fbind"), env, ENV); + type_check(self, env, ENV); cell = acons_new_c(sym, nulloc, mkloc(env->e.fbindings, env)); return rplacd(cell, fun); } else { - val hcell = gethash_c(top_fb, sym, nulloc); + val hcell = gethash_c(self, top_fb, sym, nulloc); val cell = cdr(hcell); if (cell) return rplacd(cell, fun); @@ -168,13 +170,15 @@ val env_fbind(val env, val sym, val fun) val env_vbind(val env, val sym, val obj) { + val self = lit("env-vbind"); + if (env) { val cell; - type_check(lit("env-vbind"), env, ENV); + type_check(self, env, ENV); cell = acons_new_c(sym, nulloc, mkloc(env->e.vbindings, env)); return rplacd(cell, obj); } else { - val hcell = gethash_c(top_vb, sym, nulloc); + val hcell = gethash_c(self, top_vb, sym, nulloc); val cell = cdr(hcell); if (cell) return rplacd(cell, obj); @@ -1851,8 +1855,9 @@ static val op_or(val form, val env) static val rt_defvarl(val sym) { + val self = lit("defvar"); val new_p; - val cell = gethash_c(top_vb, sym, mkcloc(new_p)); + val cell = gethash_c(self, top_vb, sym, mkcloc(new_p)); if (new_p) { uw_purge_deferred_warning(cons(var_s, sym)); @@ -3973,7 +3978,7 @@ static val me_case(val form, val menv) list_collect_decl (indexed_clauses, rtail); for (i = minkey; i <= maxkey; i = succ(i)) { - val lookup = gethash_e(hash, i); + val lookup = gethash_e(casesym, hash, i); rtail = list_collect(rtail, if3(lookup, ref(hashforms, cdr(lookup)), uniqf)); @@ -4227,6 +4232,7 @@ static val me_load_time(val form, val menv) val load(val target) { + val self = lit("load"); uses_or2; val parent = or2(load_path, null_string); val path = if3(!pure_rel_path_p(target), @@ -4252,15 +4258,15 @@ val load(val target) env_vbind(dyn_env, package_s, cur_package); if (txr_lisp_p == t) { - if (!read_eval_stream(stream, std_error)) { + if (!read_eval_stream(self, stream, std_error)) { close_stream(stream, nil); - uw_throwf(error_s, lit("load: ~a contains errors"), path, nao); + uw_throwf(error_s, lit("~a: ~a contains errors"), self, path, nao); } } else if (txr_lisp_p == chr('o')) { - if (!read_compiled_file(stream, std_error)) { + if (!read_compiled_file(self, stream, std_error)) { close_stream(stream, nil); - uw_throwf(error_s, lit("load: unable to load compiled file ~a"), - path, nao); + uw_throwf(error_s, lit("~a: unable to load compiled file ~a"), + self, path, nao); } } else { int gc = gc_state(0); @@ -4273,8 +4279,8 @@ val load(val target) uw_release_deferred_warnings(); if (parser.errors) - uw_throwf(query_error_s, lit("load: parser errors in ~a"), - path, nao); + uw_throwf(query_error_s, lit("~a: parser errors in ~a"), + self, path, nao); { val match_ctx = uw_get_match_context(); val bindings = cdr(match_ctx); @@ -5775,7 +5781,7 @@ void reg_var(val sym, val val) static void reg_symacro(val sym, val form) { - val cell = gethash_c(top_smb, sym, nulloc); + val cell = gethash_c(lit("internal initialization"), top_smb, sym, nulloc); val binding = cdr(cell); if (binding) @@ -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)); @@ -76,7 +76,7 @@ val ffi_type_operator_p(val sym); val ffi_type_p(val sym); val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes); val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in); -mem_t *ffi_closure_get_fptr(val closure); +mem_t *ffi_closure_get_fptr(val self, val closure); val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args); val ffi_typedef(val name, val type); val ffi_size(val type); @@ -125,7 +125,7 @@ val unum_carray(val carray); val num_carray(val carray); val put_carray(val carray, val offs, val stream); val fill_carray(val carray, val offs, val stream); -mem_t *union_get_ptr(val uni); +mem_t *union_get_ptr(val self, val uni); val make_union(val type, val init, val memb); val union_members(val uni); val union_get(val uni, val memb); @@ -61,7 +61,7 @@ static val trie_add(val trie, val key, val value) for (node = trie, i = zero; lt(i, len); i = plus(i, one)) { val ch = chr_str(key, i); val newnode_p; - loc place = gethash_l(node, ch, mkcloc(newnode_p)); + loc place = gethash_l(lit("trie-add"), node, ch, mkcloc(newnode_p)); if (newnode_p) set(place, make_hash(nil, nil, nil)); node = deref(place); @@ -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 @@ -32,12 +32,12 @@ val make_seeded_hash(val weak_keys, val weak_vals, val equal_based, val seed); val make_hash(val weak_keys, val weak_vals, val equal_based); val make_similar_hash(val existing); val copy_hash(val existing); -val gethash_c(val hash, val key, loc new_p); -val gethash_e(val hash, val key); +val gethash_c(val self, val hash, val key, loc new_p); +val gethash_e(val self, val hash, val key); val gethash(val hash, val key); val inhash(val hash, val key, val init); val gethash_n(val hash, val key, val notfound_val); -val gethash_f(val hash, val key, loc found); +val gethash_f(val self, val hash, val key, loc found); val sethash(val hash, val key, val value); val pushhash(val hash, val key, val value); val remhash(val hash, val key); @@ -74,9 +74,9 @@ val hash_revget(val hash, val value, val test, val keyfun); void hash_process_weak(void); -INLINE loc gethash_l(val hash, val key, loc new_p) +INLINE loc gethash_l(val self, val hash, val key, loc new_p) { - return cdr_l(gethash_c(hash, key, new_p)); + return cdr_l(gethash_c(self, hash, key, new_p)); } void hash_init(void); @@ -329,11 +329,11 @@ val throw_mismatch(val self, val obj, type_t t) type_mismatch(lit("~a: ~s is not of type ~s"), self, obj, code2type(t), nao); } -val class_check(val cobj, val class_sym) +val class_check(val self, val cobj, val class_sym) { type_assert (is_ptr(cobj) && cobj->t.type == COBJ && (cobj->co.cls == class_sym || subtypep(cobj->co.cls, class_sym)), - (lit("~s is not of type ~s"), cobj, class_sym, nao)); + (lit("~a: ~s is not of type ~s"), self, cobj, class_sym, nao)); return t; } @@ -5289,7 +5289,7 @@ val use_sym(val symbol, val package_in) if (symbol_package(symbol) != package) { val name = symbol_name(symbol); val found; - val existing = gethash_f(package->pk.symhash, name, mkcloc(found)); + val existing = gethash_f(self, package->pk.symhash, name, mkcloc(found)); if (found && symbol_package(existing) == package) { if (existing == nil) @@ -5311,8 +5311,8 @@ val unuse_sym(val symbol, val package_in) val package = get_package(self, package_in, t); val name = symbol_name(symbol); val found_visible, found_hidden; - val visible = gethash_f(package->pk.symhash, name, mkcloc(found_visible)); - val hidden = gethash_f(package->pk.hidhash, name, mkcloc(found_hidden)); + val visible = gethash_f(self, package->pk.symhash, name, mkcloc(found_visible)); + val hidden = gethash_f(self, package->pk.hidhash, name, mkcloc(found_hidden)); if (!found_visible || visible != symbol) return nil; @@ -5400,14 +5400,15 @@ val unuse_package(val unuse_list, val package_in) */ val symbol_visible(val package, val sym) { + val self = lit("internal error"); val name = symbol_name(sym); - type_check(lit("internal error"), package, PKG); + type_check(self, package, PKG); if (sym->s.package == package) return t; { - val cell = gethash_e(package->pk.symhash, name); + val cell = gethash_e(self, package->pk.symhash, name); if (cell) return eq(cdr(cell), sym); @@ -5418,7 +5419,7 @@ val symbol_visible(val package, val sym) for (; fallback; fallback = cdr(fallback)) { val fb_pkg = car(fallback); - val cell = gethash_e(fb_pkg->pk.symhash, name); + val cell = gethash_e(self, fb_pkg->pk.symhash, name); if (cell) return eq(cdr(cell), sym); @@ -5438,7 +5439,7 @@ val symbol_needs_prefix(val self, val package, val sym) { int homed_here = (sym->s.package == package); - val home_cell = gethash_e(package->pk.symhash, name); + val home_cell = gethash_e(self, package->pk.symhash, name); int present_here = (eq(cdr(home_cell), sym) != nil); val fallback = get_hash_userdata(package->pk.symhash); val fb_cell = nil; @@ -5446,7 +5447,7 @@ val symbol_needs_prefix(val self, val package, val sym) for (; fallback; fallback = cdr(fallback)) { val fb_pkg = car(fallback); - val cell = gethash_e(fb_pkg->pk.symhash, name); + val cell = gethash_e(self, fb_pkg->pk.symhash, name); if (cell) { fb_cell = cell; @@ -5479,7 +5480,7 @@ val find_symbol(val str, val package_in) if (!stringp(str)) uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao); - if ((sym = gethash_f(package->pk.symhash, str, mkcloc(found))) || found) + if ((sym = gethash_f(self, package->pk.symhash, str, mkcloc(found))) || found) return sym; return zero; @@ -5487,14 +5488,15 @@ val find_symbol(val str, val package_in) val intern(val str, val package_in) { + val self = lit("intern"); val new_p; loc place; - val package = get_package(lit("intern"), package_in, t); + val package = get_package(self, package_in, t); if (!stringp(str)) - uw_throwf(error_s, lit("intern: name ~s isn't a string"), str, nao); + uw_throwf(error_s, lit("~a: name ~s isn't a string"), self, str, nao); - place = gethash_l(package->pk.symhash, str, mkcloc(new_p)); + place = gethash_l(self, package->pk.symhash, str, mkcloc(new_p)); if (!new_p) { return deref(place); @@ -5507,14 +5509,14 @@ val intern(val str, val package_in) val unintern(val symbol, val package_in) { - val unint = lit("unintern"); - val package = get_package(unint, package_in, t); + val self = lit("unintern"); + val package = get_package(self, package_in, t); val name = symbol_name(symbol); val found_visible, found_hidden; - val visible = gethash_f(package->pk.symhash, name, mkcloc(found_visible)); - val hidden = gethash_f(package->pk.hidhash, name, mkcloc(found_hidden)); + val visible = gethash_f(self, package->pk.symhash, name, mkcloc(found_visible)); + val hidden = gethash_f(self, package->pk.hidhash, name, mkcloc(found_hidden)); - prot_sym_check(unint, name, package); + prot_sym_check(self, name, package); if (!found_visible || visible != symbol) { if (found_hidden && hidden == symbol) { @@ -5594,12 +5596,12 @@ val intern_fallback(val str, val package_in) val found; val sym; - if ((sym = gethash_f(package->pk.symhash, str, mkcloc(found))) || found) + if ((sym = gethash_f(self, package->pk.symhash, str, mkcloc(found))) || found) return sym; for (; fblist; fblist = cdr(fblist)) { val otherpkg = car(fblist); - if ((sym = gethash_f(otherpkg->pk.symhash, str, mkcloc(found))) || found) + if ((sym = gethash_f(self, otherpkg->pk.symhash, str, mkcloc(found))) || found) return sym; } } @@ -5608,7 +5610,7 @@ val intern_fallback(val str, val package_in) val new_p; loc place; - place = gethash_l(package->pk.symhash, str, mkcloc(new_p)); + place = gethash_l(self, package->pk.symhash, str, mkcloc(new_p)); if (!new_p) { return deref(place); @@ -7788,15 +7790,15 @@ val cobjp(val obj) return type(obj) == COBJ ? t : nil; } -mem_t *cobj_handle(val cobj, val cls_sym) +mem_t *cobj_handle(val self, val cobj, val cls_sym) { - class_check(cobj, cls_sym); + class_check(self, cobj, cls_sym); return cobj->co.handle; } -struct cobj_ops *cobj_ops(val cobj, val cls_sym) +struct cobj_ops *cobj_ops(val self, val cobj, val cls_sym) { - class_check(cobj, cls_sym); + class_check(self, cobj, cls_sym); return cobj->co.ops; } @@ -8638,7 +8640,7 @@ val unique(val seq, val keyfun, struct args *hashv_args) val new_p; val v = ref(seq, num_fast(i)); - (void) gethash_c(hash, funcall1(kf, v), mkcloc(new_p)); + (void) gethash_c(self, hash, funcall1(kf, v), mkcloc(new_p)); if (new_p) ptail = list_collect(ptail, v); @@ -8648,7 +8650,7 @@ val unique(val seq, val keyfun, struct args *hashv_args) val new_p; val v = car(seq); - (void) gethash_c(hash, funcall1(kf, v), mkcloc(new_p)); + (void) gethash_c(self, hash, funcall1(kf, v), mkcloc(new_p)); if (new_p) ptail = list_collect(ptail, v); @@ -9739,13 +9741,14 @@ val drop_until(val pred, val seq, val keyfun) val in(val seq, val item, val testfun, val keyfun) { + val self = lit("in"); switch (type(seq)) { case NIL: return nil; case COBJ: if (seq->co.cls == hash_s) { val found; - gethash_f(seq, item, mkcloc(found)); + gethash_f(self, seq, item, mkcloc(found)); return if3(found, t, nil); } /* fallthrough */ @@ -10499,6 +10502,7 @@ val where(val func, val seq) val sel(val seq_in, val where_in) { + val self = lit("sel"); list_collect_decl (out, ptail); val seq = nullify(seq_in); val where = if3(functionp(where_in), @@ -10517,7 +10521,7 @@ val sel(val seq_in, val where_in) val found; loc pfound = mkcloc(found); val key = car(where); - val value = gethash_f(seq, key, pfound); + val value = gethash_f(self, seq, key, pfound); if (found) sethash(newhash, key, value); @@ -10660,6 +10664,8 @@ val env(void) static void obj_init(void) { + val self = lit("internal init"); + /* * No need to GC-protect the convenience variables which hold the interned * symbols, because the interned_syms list holds a reference to all the @@ -10688,10 +10694,11 @@ static void obj_init(void) /* nil can't be interned because it's not a SYM object; it works as a symbol because the nil case is handled by symbol-manipulating function. */ - rplacd(gethash_c(user_package->pk.symhash, nil_string, nulloc), nil); + rplacd(gethash_c(self, user_package->pk.symhash, + nil_string, nulloc), nil); /* t can't be interned, because intern needs t in order to do its job. */ - t = cdr(rplacd(gethash_c(user_package->pk.symhash, + t = cdr(rplacd(gethash_c(self, user_package->pk.symhash, lit("t"), nulloc), make_sym(lit("t")))); set(mkloc(t->s.package, t), user_package); @@ -11008,10 +11015,11 @@ static int unquote_star_check(val obj, val pretty) val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) { + val self = lit("print"); val ret = obj; if (ctx && circle_print_eligible(obj)) { - val cell = gethash_c(ctx->obj_hash, obj, nulloc); + val cell = gethash_c(self, ctx->obj_hash, obj, nulloc); val label = cdr(cell); if (label == t) { @@ -11364,11 +11372,12 @@ dot: static void populate_obj_hash(val obj, struct strm_ctx *ctx) { + val self = lit("print"); tail: if (circle_print_eligible(obj)) { if (ctx->obj_hash_prev) { val prev_cell; - val label = gethash_f(ctx->obj_hash_prev, obj, mkcloc(prev_cell)); + val label = gethash_f(self, ctx->obj_hash_prev, obj, mkcloc(prev_cell)); if (label == colon_k) uw_throwf(error_s, lit("print: unexpected duplicate object " @@ -11377,7 +11386,7 @@ tail: return; } else { val new_p; - val cell = gethash_c(ctx->obj_hash, obj, mkcloc(new_p)); + val cell = gethash_c(self, ctx->obj_hash, obj, mkcloc(new_p)); if (!new_p) { rplacd(cell, t); @@ -11448,16 +11457,17 @@ tail: static void obj_hash_merge(val parent_hash, val child_hash) { + val self = lit("print"); val iter, cell; for (iter = hash_begin(child_hash); (cell = hash_next(iter));) { val new_p; - val pcell = gethash_c(parent_hash, car(cell), mkcloc(new_p)); + val pcell = gethash_c(self, parent_hash, car(cell), mkcloc(new_p)); if (new_p) rplacd(pcell, cdr(cell)); else - uw_throwf(error_s, lit("print: unexpected duplicate object " - "(internal error?)"), nao); + uw_throwf(error_s, lit("~a: unexpected duplicate object " + "(internal error?)"), self, nao); } } @@ -515,7 +515,7 @@ INLINE val type_check(val self, val obj, type_t typecode) throw_mismatch(self, obj, typecode); return t; } -val class_check(val cobj, val class_sym); +val class_check(val self, val cobj, val class_sym); val car(val cons); val cdr(val cons); INLINE val us_car(val cons) { return cons->c.car; } @@ -972,8 +972,8 @@ val length_str_lt(val str, val len); val length_str_le(val str, val len); val cobj(mem_t *handle, val cls_sym, struct cobj_ops *ops); val cobjp(val obj); -mem_t *cobj_handle(val cobj, val cls_sym); -struct cobj_ops *cobj_ops(val cobj, val cls_sym); +mem_t *cobj_handle(val self, val cobj, val cls_sym); +struct cobj_ops *cobj_ops(val self, 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); @@ -4237,6 +4237,7 @@ static val v_assert(match_files_ctx *c) static val v_load(match_files_ctx *c) { + val self = lit("@(load)"); uses_or2; spec_bind (specline, first_spec, c->spec); val sym = first(first_spec); @@ -4316,11 +4317,11 @@ static val v_load(match_files_ctx *c) } else { uw_set_match_context(cons(c->spec, c->bindings)); - if (txr_lisp_p == chr('o') && !read_compiled_file(stream, std_error)) { + if (txr_lisp_p == chr('o') && !read_compiled_file(self, stream, std_error)) { close_stream(stream, nil); uw_throwf(error_s, lit("load: unable to load compiled file ~a"), path, nao); - } else if (!read_eval_stream(stream, std_error)) { + } else if (!read_eval_stream(self, stream, std_error)) { close_stream(stream, nil); sem_error(specline, lit("load: ~a contains errors"), path, nao); } @@ -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); } @@ -121,8 +121,8 @@ val nread(val source_in, val error_stream, val error_return_val, val name_in, val lineno); val iread(val source_in, val error_stream, val error_return_val, val name_in, val lineno); -val read_eval_stream(val stream, val error_stream); -val read_compiled_file(val stream, val error_stream); +val read_eval_stream(val self, val stream, val error_stream); +val read_compiled_file(val self, val stream, val error_stream); #if HAVE_TERMIOS val repl(val bindings, val in_stream, val out_stream); #endif @@ -1628,7 +1628,7 @@ static val rlviable(val form) val rlset(val form, val info) { if (rlviable(form)) { - val cell = gethash_c(form_to_ln_hash, form, nulloc); + val cell = gethash_c(lit("rlcp"), form_to_ln_hash, form, nulloc); loc place = cdr_l(cell); if (nilp(deref(place))) set(place, info); @@ -112,10 +112,11 @@ static rand32_t rand32(struct rand_state *r) val make_random_state(val seed, val warmup) { + val self = lit("make-random-state"); val rs = make_state(); int i = 0; struct rand_state *r = coerce(struct rand_state *, - cobj_handle(rs, random_state_s)); + cobj_handle(self, rs, random_state_s)); seed = default_null_arg(seed); warmup = default_null_arg(warmup); @@ -154,7 +155,7 @@ val make_random_state(val seed, val warmup) #endif } else if (random_state_p(seed)) { struct rand_state *rseed = coerce(struct rand_state *, - cobj_handle(seed, random_state_s)); + cobj_handle(self, seed, random_state_s)); *r = *rseed; return rs; } else if (vectorp(seed)) { @@ -193,8 +194,10 @@ val make_random_state(val seed, val warmup) val random_state_get_vec(val state) { + val self = lit("random-state-get-vec"); struct rand_state *r = coerce(struct rand_state *, - cobj_handle(default_arg(state, random_state), + cobj_handle(self, + default_arg(state, random_state), random_state_s)); int i; val vec = vector(num_fast(17), nil); @@ -209,16 +212,20 @@ val random_state_get_vec(val state) val random_fixnum(val state) { + val self = lit("random-fixnum"); struct rand_state *r = coerce(struct rand_state *, - cobj_handle(default_arg(state, random_state), + cobj_handle(self, + default_arg(state, random_state), random_state_s)); return num(rand32(r) & NUM_MAX); } static val random_float(val state) { + val self = lit("random-float"); struct rand_state *r = coerce(struct rand_state *, - cobj_handle(default_arg(state, random_state), + cobj_handle(self, + default_arg(state, random_state), random_state_s)); union hack { volatile double d; @@ -245,7 +252,7 @@ val random(val state, val modulus) { val self = lit("random"); struct rand_state *r = coerce(struct rand_state *, - cobj_handle(state, random_state_s)); + cobj_handle(self, state, random_state_s)); mp_int *m; if (bignump(modulus) && !ISNEG(m = mp(modulus))) { @@ -2245,7 +2245,9 @@ val regexp(val obj) val regex_source(val compiled_regex) { - regex_t *regex = coerce(regex_t *, cobj_handle(compiled_regex, regex_s)); + val self = lit("regex-source"); + regex_t *regex = coerce(regex_t *, + cobj_handle(self, compiled_regex, regex_s)); return regex->source; } @@ -2416,7 +2418,8 @@ static void print_rec(val exp, val stream, int *semi_flag) static void regex_print(val obj, val stream, val pretty, struct strm_ctx *ctx) { - regex_t *regex = coerce(regex_t *, cobj_handle(obj, regex_s)); + val self = lit("regex-print"); + regex_t *regex = coerce(regex_t *, cobj_handle(self, obj, regex_s)); int semi_flag = 0; (void) pretty; @@ -2429,7 +2432,8 @@ static void regex_print(val obj, val stream, val pretty, struct strm_ctx *ctx) static cnum regex_run(val compiled_regex, const wchar_t *str) { - regex_t *regex = coerce(regex_t *, cobj_handle(compiled_regex, regex_s)); + val self = lit("regex-run"); + regex_t *regex = coerce(regex_t *, cobj_handle(self, compiled_regex, regex_s)); return if3(regex->kind == REGEX_DV, dv_run(regex->r.dv, str), @@ -2471,9 +2475,9 @@ static void regex_machine_reset(regex_machine_t *regm) regm->n.last_accept_pos = regm->n.count; } -static void regex_machine_init(regex_machine_t *regm, val reg) +static void regex_machine_init(val self, regex_machine_t *regm, val reg) { - regex_t *regex = coerce(regex_t *, cobj_handle(reg, regex_s)); + regex_t *regex = coerce(regex_t *, cobj_handle(self, reg, regex_s)); if (regex->kind == REGEX_DV) { regm->n.is_nfa = 0; @@ -2566,6 +2570,7 @@ static regm_result_t regex_machine_feed(regex_machine_t *regm, wchar_t ch) val search_regex(val haystack, val needle_regex, val start, val from_end) { + val self = lit("search-regex"); val slen = nil; start = default_arg(start, zero); from_end = default_null_arg(from_end); @@ -2602,7 +2607,7 @@ val search_regex(val haystack, val needle_regex, val start, if (length_str_lt(haystack, pos)) return nil; - regex_machine_init(®m, needle_regex); + regex_machine_init(self, ®m, needle_regex); again: for (i = pos; length_str_gt(haystack, i); i = plus(i, one)) { @@ -2689,6 +2694,7 @@ val range_regex_all(val haystack, val needle_regex, val start, val end) val match_regex(val str, val reg, val pos) { + val self = lit("match-regex"); regex_machine_t regm; val i, retval; regm_result_t last_res = REGM_INCOMPLETE; @@ -2703,7 +2709,7 @@ val match_regex(val str, val reg, val pos) return nil; } - regex_machine_init(®m, reg); + regex_machine_init(self, ®m, reg); for (i = pos; length_str_gt(str, i); i = plus(i, one)) { last_res = regex_machine_feed(®m, c_chr(chr_str(str, i))); @@ -2764,6 +2770,7 @@ static val match_regex_right_old(val str, val regex, val end) val match_regex_right(val str, val regex, val end) { + val self = lit("match-regex-right"); val pos = zero; val len = length(str); @@ -2782,7 +2789,7 @@ val match_regex_right(val str, val regex, val end) val i ; regm_result_t last_res = REGM_INCOMPLETE; - regex_machine_init(®m, regex); + regex_machine_init(self, ®m, regex); for (i = pos; lt(i, end); i = plus(i, one)) { last_res = regex_machine_feed(®m, c_chr(chr_str(str, i))); @@ -2810,6 +2817,7 @@ val match_regex_right(val str, val regex, val end) val regex_prefix_match(val reg, val str, val pos) { + val self = lit("regex-prefix-match"); regex_machine_t regm; val i; regm_result_t last_res; @@ -2824,7 +2832,7 @@ val regex_prefix_match(val reg, val str, val pos) return nil; } - regex_machine_init(®m, reg); + regex_machine_init(self, ®m, reg); last_res = regex_machine_infer_init_state(®m); @@ -3108,6 +3116,7 @@ val regex_range_search_fun(val regex, val start, val from_end) val read_until_match(val regex, val stream_in, val include_match_in) { + val self = lit("read-until-match"); regex_machine_t regm; val out = nil; val stack = nil; @@ -3115,7 +3124,7 @@ val read_until_match(val regex, val stream_in, val include_match_in) val stream = default_arg(stream_in, std_input); val include_match = default_null_arg(include_match_in); - regex_machine_init(®m, regex); + regex_machine_init(self, ®m, regex); for (;;) { val ch = get_char(stream); @@ -747,14 +747,15 @@ static val stdio_clear_error(val stream) static val stdio_get_fd(val stream) { + val self = lit("stream-fd"); struct stdio_handle *h = coerce(struct stdio_handle *, - cobj_handle(stream, stdio_stream_s)); + cobj_handle(self, stream, stdio_stream_s)); return h->f ? num(fileno(h->f)) : nil; } val generic_get_line(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops); const size_t min_size = 512; size_t size = 0; size_t fill = 0; @@ -1471,8 +1472,8 @@ val normalize_mode_no_bin(struct stdio_mode *m, val mode_str, struct stdio_mode val set_mode_props(const struct stdio_mode m, val stream) { if (m.interactive || m.linebuf || m.unbuf || m.buforder != -1) { - struct stdio_handle *h = coerce(struct stdio_handle *, - cobj_handle(stream, stdio_stream_s)); + struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle); + if (h->f) { int size = m.buforder == -1 ? 0 : 1024 << m.buforder; @@ -1561,32 +1562,42 @@ val make_sock_stream(FILE *f, val family, val type) val stream_fd(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("fileno"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_fd(stream); } #if HAVE_SOCKETS val sock_family(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("sock-family"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_sock_family(stream); } val sock_type(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("sock-type"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_sock_type(stream); } val sock_peer(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("sock-peer"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_sock_peer(stream); } val sock_set_peer(val stream, val peer) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("sock-set-peer"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->set_sock_peer(stream, peer); } #endif @@ -2183,8 +2194,9 @@ val make_string_output_stream(void) val get_string_from_stream(val stream) { + val self = lit("get-string-from-stream"); struct string_out *so = coerce(struct string_out *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); if (stream->co.ops == &string_out_ops.cobj_ops) { val out = nil; @@ -2300,8 +2312,9 @@ val make_strlist_output_stream(void) val get_list_from_stream(val stream) { + val self = lit("get-list-from-stream"); struct strlist_out *s = coerce(struct strlist_out *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); if (stream->co.ops == &strlist_out_ops.cobj_ops) { val stray = get_string_from_stream(s->strstream); @@ -2665,11 +2678,11 @@ static val delegate_set_sock_peer(val stream, val peer) #endif -static val make_delegate_stream(val orig_stream, size_t handle_size, +static val make_delegate_stream(val self, val orig_stream, size_t handle_size, struct cobj_ops *ops) { struct strm_ops *orig_ops = coerce(struct strm_ops *, - cobj_ops(orig_stream, stream_s)); + cobj_ops(self, orig_stream, stream_s)); struct delegate_base *db = coerce(struct delegate_base *, chk_calloc(1, handle_size)); val delegate_stream; @@ -2729,7 +2742,8 @@ static struct strm_ops record_adapter_ops = val record_adapter(val regex, val stream, val include_match) { - val rec_adapter = make_delegate_stream(default_arg(stream, std_input), + val self = lit("record-adapter"); + val rec_adapter = make_delegate_stream(self, default_arg(stream, std_input), sizeof (struct record_adapter_base), &record_adapter_ops.cobj_ops); struct record_adapter_base *rb = coerce(struct record_adapter_base *, @@ -2747,13 +2761,17 @@ val streamp(val obj) val stream_set_prop(val stream, val ind, val prop) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("stream-set-prop"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->set_prop(stream, ind, prop); } val stream_get_prop(val stream, val ind) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("stream-get-prop"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_prop(stream, ind); } @@ -2769,84 +2787,106 @@ val real_time_stream_p(val obj) val close_stream(val stream, val throw_on_error) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("close-stream"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->close(stream, throw_on_error); } val get_error(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("get-error"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_error(stream); } val get_error_str(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("get-error-str"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_error_str(stream); } val clear_error(val stream) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("clear-error"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->clear_error(stream); } val get_line(val stream_in) { + val self = lit("get-line"); val stream = default_arg(stream_in, std_input); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_line(stream); } val get_char(val stream_in) { + val self = lit("get-char"); val stream = default_arg(stream_in, std_input); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_char(stream); } val get_byte(val stream_in) { + val self = lit("get-byte"); val stream = default_arg(stream_in, std_input); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->get_byte(stream); } val unget_char(val ch, val stream_in) { + val self = lit("unget-char"); val stream = default_arg(stream_in, std_input); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); if (!is_chr(ch)) - type_mismatch(lit("unget-char: ~s is not a character"), ch, nao); + type_mismatch(lit("~a: ~s is not a character"), self, ch, nao); return ops->unget_char(stream, ch); } val unget_byte(val byte, val stream_in) { + val self = lit("unget-byte"); cnum b = c_num(byte); val stream = default_arg(stream_in, std_input); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); if (b < 0 || b > 255) - uw_throwf(file_error_s, lit("unget-byte on ~a: byte value ~a out of range"), - stream, byte, nao); + uw_throwf(file_error_s, lit("~a: stream ~s, byte value ~a out of range"), + self, stream, byte, nao); return ops->unget_byte(stream, b); } val put_buf(val buf, val pos_in, val stream_in) { + val self = lit("put-buf"); val stream = default_arg(stream_in, std_output); cnum pos = c_num(default_arg(pos_in, zero)); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->put_buf(stream, buf, pos); } val fill_buf(val buf, val pos_in, val stream_in) { + val self = lit("fill-buf"); val stream = default_arg(stream_in, std_input); cnum pos = c_num(default_arg(pos_in, zero)); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->fill_buf(stream, buf, pos); } @@ -3461,11 +3501,12 @@ val vformat_to_string(val fmtstr, va_list vl) val format(val stream, val str, ...) { + val self = lit("format"); uses_or2; val st = if3(stream == t, std_output, or2(stream, make_string_output_stream())); - class_check(st, stream_s); + class_check(self, st, stream_s); { va_list vl; @@ -3492,11 +3533,13 @@ static val put_indent(val stream, struct strm_ops *ops, cnum chars) val put_string(val string, val stream_in) { + val self = lit("put-string"); if (lazy_stringp(string)) { return lazy_str_put(string, stream_in); } else { val stream = default_arg(stream_in, std_output); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); struct strm_base *s = coerce(struct strm_base *, stream->co.handle); cnum col = s->column; @@ -3532,8 +3575,10 @@ val put_string(val string, val stream_in) val put_char(val ch, val stream_in) { + val self = lit("put-char"); val stream = default_arg(stream_in, std_output); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); struct strm_base *s = coerce(struct strm_base *, stream->co.handle); wint_t cch = c_chr(ch); @@ -3568,13 +3613,15 @@ val put_char(val ch, val stream_in) val put_byte(val byte, val stream_in) { + val self = lit("put-byte"); val stream = default_arg(stream_in, std_output); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); cnum b = c_num(byte); if (b < 0 || b > 255) - uw_throwf(file_error_s, lit("put-byte on ~a: byte value ~a out of range"), - stream, byte, nao); + uw_throwf(file_error_s, lit("~a: stream ~s: byte value ~a out of range"), + self, stream, byte, nao); return ops->put_byte(stream, b); } @@ -3604,14 +3651,18 @@ val put_lines(val lines, val stream) val flush_stream(val stream_in) { + val self = lit("flush-stream"); val stream = default_arg(stream_in, std_output); - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); return ops->flush(stream); } val seek_stream(val stream, val offset, val whence) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("seek-stream"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); enum strm_whence w; if (whence == from_start_k) @@ -3621,15 +3672,17 @@ val seek_stream(val stream, val offset, val whence) else if (whence == from_end_k) w = strm_end; else - uw_throwf(file_error_s, lit("seek: ~a is not a valid whence argument"), - whence, nao); + uw_throwf(file_error_s, lit("~a: ~s is not a valid whence argument"), + self, whence, nao); return ops->seek(stream, offset, w); } val truncate_stream(val stream, val len) { - struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s)); + val self = lit("truncate-stream"); + struct strm_ops *ops = coerce(struct strm_ops *, + cobj_ops(self, stream, stream_s)); if (missingp(len)) len = ops->seek(stream, zero, strm_cur); return ops->truncate(stream, len); @@ -3637,15 +3690,17 @@ val truncate_stream(val stream, val len) val get_indent_mode(val stream) { + val self = lit("get-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); return num_fast(s->indent_mode); } val test_set_indent_mode(val stream, val compare, val mode) { + val self = lit("test-set-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); val oldval = num_fast(s->indent_mode); if (oldval == compare) s->indent_mode = convert(enum indent_mode, c_num(mode)); @@ -3654,8 +3709,9 @@ val test_set_indent_mode(val stream, val compare, val mode) val set_indent_mode(val stream, val mode) { + val self = lit("set-indent-mode"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); val oldval = num_fast(s->indent_mode); s->indent_mode = convert(enum indent_mode, c_num(mode)); return oldval; @@ -3663,15 +3719,17 @@ val set_indent_mode(val stream, val mode) val get_indent(val stream) { + val self = lit("get-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); return num(s->indent_chars); } val set_indent(val stream, val indent) { + val self = lit("set-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); val oldval = num(s->indent_chars); s->indent_chars = c_num(indent); if (s->indent_chars < 0) @@ -3681,8 +3739,9 @@ val set_indent(val stream, val indent) val inc_indent(val stream, val delta) { + val self = lit("inc-indent"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); val oldval = num(s->indent_chars); val col = num(s->column); s->indent_chars = c_num(plus(delta, col)); @@ -3693,8 +3752,9 @@ val inc_indent(val stream, val delta) val width_check(val stream, val alt) { + val self = lit("width-check"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); if ((s->indent_mode == indent_code && s->column >= s->indent_chars + s->code_width) || @@ -3714,16 +3774,16 @@ val width_check(val stream, val alt) val force_break(val stream) { + val self = lit("force-break"); struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + cobj_handle(self, stream, stream_s)); s->force_break = 1; return stream; } struct strm_ctx *get_set_ctx(val stream, struct strm_ctx *ctx) { - struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + struct strm_base *s = coerce(struct strm_base *, stream->co.handle); struct strm_ctx *ret = s->ctx; s->ctx = ctx; return ret; @@ -3731,8 +3791,7 @@ struct strm_ctx *get_set_ctx(val stream, struct strm_ctx *ctx) struct strm_ctx *get_ctx(val stream) { - struct strm_base *s = coerce(struct strm_base *, - cobj_handle(stream, stream_s)); + struct strm_base *s = coerce(struct strm_base *, stream->co.handle); return s->ctx; } @@ -224,7 +224,8 @@ static struct struct_type *stype_handle(val *pobj, val ctx) if (!stype) no_such_struct(ctx, obj); *pobj = stype; - return coerce(struct struct_type *, cobj_handle(stype, struct_type_s)); + return coerce(struct struct_type *, cobj_handle(ctx, stype, + struct_type_s)); } case COBJ: if (obj->co.cls == struct_type_s) @@ -265,7 +266,7 @@ val make_struct_type(val name, val super, no_such_struct(self, super); super = supertype; } else if (super) { - class_check(super, struct_type_s); + class_check(self, super, struct_type_s); } if (!bindable(name)) { @@ -472,15 +472,16 @@ static int parse_once_noerr(val stream, val name, parser_t *parser) exsym, exargs, std_error, pfx); } -static val read_eval_stream_noerr(val stream, val name, val error_stream) +static val read_eval_stream_noerr(val self, val stream, val name, val error_stream) { val pfx = format(nil, lit("~a:"), name, nao); - ignerr_func_body(val, nil, read_eval_stream(stream, error_stream), + ignerr_func_body(val, nil, read_eval_stream(self, stream, error_stream), exsym, exargs, std_error, pfx); } int txr_main(int argc, char **argv) { + val self = lit("txr startup"); uses_or2; val specstring = nil; val spec = nil; @@ -1059,11 +1060,11 @@ int txr_main(int argc, char **argv) } if (txr_lisp_p == chr('o')) { - val result = read_compiled_file(parse_stream, std_error); + val result = read_compiled_file(self, parse_stream, std_error); if (!enter_repl) return result ? 0 : EXIT_FAILURE; } else { - val result = read_eval_stream_noerr(parse_stream, spec_file_str, + val result = read_eval_stream_noerr(self, parse_stream, spec_file_str, std_error); close_stream(parse_stream, nil); @@ -880,7 +880,8 @@ static void call_copy_handlers(uw_frame_t *upto, int parent) static val revive_cont(val dc, val arg) { - struct cont *cont = coerce(struct cont *, cobj_handle(dc, sys_cont_s)); + val self = lit("revive-cont"); + struct cont *cont = coerce(struct cont *, cobj_handle(self, dc, sys_cont_s)); if (arg == sys_cont_free_s) { free(cont->stack); @@ -111,9 +111,9 @@ static struct vm_desc_links vmd_list = { coerce(struct vm_desc *, &vmd_list), coerce(struct vm_desc *, &vmd_list) }; -static struct vm_desc *vm_desc_struct(val obj) +static struct vm_desc *vm_desc_struct(val self, val obj) { - return coerce(struct vm_desc *, cobj_handle(obj, vm_desc_s)); + return coerce(struct vm_desc *, cobj_handle(self, obj, vm_desc_s)); } val vm_make_desc(val nlevels, val nregs, val bytecode, @@ -175,31 +175,36 @@ val vm_make_desc(val nlevels, val nregs, val bytecode, static val vm_desc_nlevels(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm_desc_nlevels"); + struct vm_desc *vd = vm_desc_struct(self, desc); return num(vd->nlvl); } static val vm_desc_nregs(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm-desc-nregs"); + struct vm_desc *vd = vm_desc_struct(self, desc); return num(vd->nreg); } static val vm_desc_bytecode(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm-desc-bytecode"); + struct vm_desc *vd = vm_desc_struct(self, desc); return vd->bytecode; } static val vm_desc_datavec(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm-desc-datavec"); + struct vm_desc *vd = vm_desc_struct(self, desc); return vd->datavec; } static val vm_desc_symvec(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm-desc-symvec"); + struct vm_desc *vd = vm_desc_struct(self, desc); return vd->symvec; } @@ -227,9 +232,9 @@ static void vm_desc_mark(val obj) gc_mark(vd->stab[i].bind); } -static struct vm_closure *vm_closure_struct(val obj) +static struct vm_closure *vm_closure_struct(val self, val obj) { - return coerce(struct vm_closure *, cobj_handle(obj, vm_closure_s)); + return coerce(struct vm_closure *, cobj_handle(self, obj, vm_closure_s)); } static val vm_make_closure(struct vm *vm, int frsz) @@ -1035,7 +1040,8 @@ NOINLINE static val vm_execute(struct vm *vm) val vm_execute_toplevel(val desc) { - struct vm_desc *vd = vm_desc_struct(desc); + val self = lit("vm-execute-toplevel"); + struct vm_desc *vd = vm_desc_struct(self, desc); struct vm vm; val *frame = coerce(val *, alloca(sizeof *frame * vd->frsz)); struct vm_env *dspl = coerce(struct vm_env *, frame + vd->nreg); @@ -1057,11 +1063,12 @@ val vm_execute_toplevel(val desc) val vm_execute_closure(val fun, struct args *args) { + val self = lit("vm-execute-closure"); val closure = fun->f.env; val desc = fun->f.f.vm_desc; int fixparam = fun->f.fixparam; int variadic = fun->f.variadic; - struct vm_desc *vd = vm_desc_struct(desc); + struct vm_desc *vd = vm_desc_struct(self, desc); struct vm_closure *vc = coerce(struct vm_closure *, closure->co.handle); struct vm vm; val *frame = coerce(val *, alloca(sizeof *frame * vd->frsz)); @@ -1122,13 +1129,15 @@ val vm_execute_closure(val fun, struct args *args) static val vm_closure_desc(val closure) { - struct vm_closure *vc = vm_closure_struct(closure); + val self = lit("vm-closure-desc"); + struct vm_closure *vc = vm_closure_struct(self, closure); return vc->vd->self; } static val vm_closure_entry(val closure) { - struct vm_closure *vc = vm_closure_struct(closure); + val self = lit("vm-closure-entry"); + struct vm_closure *vc = vm_closure_struct(self, closure); return unum(vc->ip); } |