diff options
| -rw-r--r-- | arith.c | 2 | ||||
| -rw-r--r-- | eval.c | 32 | ||||
| -rw-r--r-- | gc.c | 2 | ||||
| -rw-r--r-- | lib.c | 69 | ||||
| -rw-r--r-- | lib.h | 6 | ||||
| -rw-r--r-- | signal.c | 5 |
6 files changed, 60 insertions, 56 deletions
@@ -2349,7 +2349,7 @@ val flo_int(val i) { double d; - type_check(i, BGNUM); + type_check(self, i, BGNUM); if (mp_to_double(mp(i), &d) != MP_OKAY) uw_throwf(error_s, lit("~a: bignum to float conversion failed"), self, nao); @@ -125,7 +125,7 @@ val make_env(val vbindings, val fbindings, val up_env) val copy_env(val oenv) { - type_check(oenv, ENV); + type_check(lit("copy-env"), oenv, ENV); { val nenv = make_obj(); @@ -154,7 +154,7 @@ val env_fbind(val env, val sym, val fun) { if (env) { val cell; - type_check(env, ENV); + type_check(lit("env-fbind"), env, ENV); cell = acons_new_c(sym, nulloc, mkloc(env->e.fbindings, env)); return rplacd(cell, fun); } else { @@ -170,7 +170,7 @@ val env_vbind(val env, val sym, val obj) { if (env) { val cell; - type_check(env, ENV); + type_check(lit("env-vbind"), env, ENV); cell = acons_new_c(sym, nulloc, mkloc(env->e.vbindings, env)); return rplacd(cell, obj); } else { @@ -185,7 +185,7 @@ val env_vbind(val env, val sym, val obj) static void env_vb_to_fb(val env) { if (env) { - type_check(env, ENV); + type_check(lit("expand"), env, ENV); env->e.fbindings = env->e.vbindings; env->e.vbindings = nil; } @@ -410,7 +410,7 @@ val lookup_global_var(val sym) val lookup_var(val env, val sym) { if (env) { - type_check(env, ENV); + type_check(lit("variable lookup"), env, ENV); for (; env; env = env->e.up_env) { val binding = assoc(sym, env->e.vbindings); @@ -436,7 +436,7 @@ val lookup_sym_lisp1(val env, val sym) uses_or2; if (env) { - type_check(env, ENV); + type_check(lit("lisp-1-style lookup"), env, ENV); for (; env; env = env->e.up_env) { val binding = or2(assoc(sym, env->e.vbindings), @@ -505,7 +505,7 @@ val lookup_fun(val env, val sym) return or2(gethash(top_fb, sym), if2(lisplib_try_load(sym), gethash(top_fb, sym))); } else { - type_check(env, ENV); + type_check(lit("function lookup"), env, ENV); { val binding = assoc(sym, env->e.fbindings); @@ -521,7 +521,7 @@ val func_get_name(val fun, val env) env = default_null_arg(env); if (env) { - type_check(env, ENV); + type_check(lit("func-get-name"), env, ENV); { val iter; @@ -560,7 +560,7 @@ static val lookup_mac(val menv, val sym) return or2(gethash(top_mb, sym), if2(lisplib_try_load(sym), gethash(top_mb, sym))); } else { - type_check(menv, ENV); + type_check(lit("macro lookup"), menv, ENV); { val binding = assoc(sym, menv->e.fbindings); @@ -579,7 +579,7 @@ static val lookup_symac(val menv, val sym) return or2(gethash(top_smb, sym), if2(lisplib_try_load(sym), gethash(top_smb, sym))); } else { - type_check(menv, ENV); + type_check(lit("symacro lookup"), menv, ENV); { val binding = assoc(sym, menv->e.vbindings); @@ -598,7 +598,7 @@ static val lookup_symac_lisp1(val menv, val sym) return or2(gethash(top_smb, sym), if2(lisplib_try_load(sym), gethash(top_smb, sym))); } else { - type_check(menv, ENV); + type_check(lit("symacro lookup"), menv, ENV); /* Of course, we are not looking for symbol macros in the operator macro * name space. Rather, the object of the lookup rule implemented by this @@ -630,7 +630,7 @@ static val lexical_var_p(val menv, val sym) if (nilp(menv)) { return nil; } else { - type_check(menv, ENV); + type_check(lit("lexical-var-p"), menv, ENV); { val binding = assoc(sym, menv->e.vbindings); @@ -647,7 +647,7 @@ static val lexical_fun_p(val menv, val sym) if (nilp(menv)) { return nil; } else { - type_check(menv, ENV); + type_check(lit("lexical-fun-p"), menv, ENV); { val binding = assoc(sym, menv->e.fbindings); @@ -664,7 +664,7 @@ static val lexical_lisp1_binding(val menv, val sym) if (nilp(menv)) { return nil; } else { - type_check(menv, ENV); + type_check(lit("lexical-lisp1-binding"), menv, ENV); { val binding = assoc(sym, menv->e.vbindings); @@ -714,7 +714,7 @@ static val squash_menv_deleting_range(val menv, val upto_menv) out_env = make_env(nil, nil, nil); for (iter = menv; iter && iter != upto_menv; iter = next) { - type_check(iter, ENV); + type_check(lit("expand-with-free-refs"), iter, ENV); varshadows = append2(varshadows, mapcar(car_f, iter->e.vbindings)); funshadows = append2(funshadows, mapcar(car_f, iter->e.fbindings)); next = iter->e.up_env; @@ -2896,7 +2896,7 @@ static val op_upenv(val form, val env) { val args = cdr(form); val expr = pop(&args); - type_check(env, ENV); + type_check(car(form), env, ENV); return eval(expr, env->e.up_env, expr); } @@ -888,7 +888,7 @@ static val gc_wrap(void) val gc_finalize(val obj, val fun, val rev_order_p) { - type_check(fun, FUN); + type_check(lit("gc-finalize"), fun, FUN); rev_order_p = default_null_arg(rev_order_p); @@ -324,9 +324,9 @@ static void noreturn unsup_obj(val self, val obj) abort(); } -val throw_mismatch(val obj, type_t t) +val throw_mismatch(val self, val obj, type_t t) { - type_mismatch(lit("~s is not of type ~s"), obj, code2type(t), nao); + type_mismatch(lit("~a: ~s is not of type ~s"), self, obj, code2type(t), nao); } val type_check2(val obj, int t1, int t2) @@ -2915,7 +2915,7 @@ void rcyc_empty(void) val lcons_fun(val lcons) { - type_check(lcons, LCONS); + type_check(lit("lcons-fun"), lcons, LCONS); return lcons->lc.func; } @@ -3155,7 +3155,7 @@ val flo(double n) double c_flo(val num, val self) { - type_check(num, FLNUM); + type_check(self, num, FLNUM); return num->fl.n; } @@ -3625,9 +3625,10 @@ val downcase_str(val str) val string_extend(val str, val tail) { - type_check(str, STR); + val self = lit("string-extend"); + + type_check(self, str, STR); { - val self = lit("string-extend"); cnum len = c_fixnum(length_str(str), self); cnum oalloc = c_fixnum(str->st.alloc, self), alloc = oalloc; cnum delta, needed; @@ -5108,13 +5109,13 @@ val break_str(val str, val set) val symbol_name(val sym) { if (sym) - type_check(sym, SYM); + type_check(lit("symbol-name"), sym, SYM); return sym ? sym->s.name : nil_string; } static void symbol_setname(val sym, val name) { - type_check(sym, SYM); + type_check(lit("internal error"), sym, SYM); sym->s.name = name; } @@ -5122,7 +5123,7 @@ val symbol_package(val sym) { if (sym == nil) return user_package; - type_check(sym, SYM); + type_check(lit("symbol-package"), sym, SYM); return sym->s.package; } @@ -5212,7 +5213,7 @@ static val get_package(val fname, val package, val missing_ok) uw_throwf(error_s, lit("~a: no such package: ~s"), fname, package, nao); return p; } - type_check (package, PKG); + type_check(fname, package, PKG); return package; } @@ -5234,7 +5235,7 @@ val package_alist(void) val package_name(val package) { - type_check (package, PKG); + type_check(lit("package-name"), package, PKG); return package->pk.name; } @@ -5417,7 +5418,7 @@ val unuse_package(val unuse_list, val package_in) val symbol_visible(val package, val sym) { val name = symbol_name(sym); - type_check (package, PKG); + type_check(lit("internal error"), package, PKG); if (sym->s.package == package) return t; @@ -5450,7 +5451,7 @@ val symbol_visible(val package, val sym) val symbol_needs_prefix(val self, val package, val sym) { val name = symbol_name(sym); - type_check (package, PKG); + type_check (self, package, PKG); { int homed_here = (sym->s.package == package); @@ -6145,22 +6146,23 @@ val func_vm(val closure, val desc, int fixparam, int reqargs, int variadic) val func_get_form(val fun) { - type_check(fun, FUN); + val self = lit("func-get-form"); + type_check(self, fun, FUN); if (fun->f.functype != FINTERP) - uw_throwf(error_s, lit("func-get-form: ~a is not an interpreted function"), - fun, nao); + uw_throwf(error_s, lit("~a: ~a is not an interpreted function"), + self, fun, nao); return fun->f.f.interp_fun; } val func_get_env(val fun) { - type_check(fun, FUN); + type_check(lit("func-get-env"), fun, FUN); return fun->f.env; } val func_set_env(val fun, val env) { - type_check(fun, FUN); + type_check(lit("func-set-env"), fun, FUN); set(mkloc(fun->f.env, fun), env); return env; } @@ -7125,7 +7127,8 @@ val vectorp(val vec) val vec_set_length(val vec, val length) { - type_check(vec, VEC); + val self = lit("vec-set-length"); + type_check(self, vec, VEC); { cnum new_length = c_num(length); @@ -7133,13 +7136,13 @@ val vec_set_length(val vec, val length) cnum old_alloc = c_num(vec->v.vec[vec_alloc]); if (new_length < 0) - uw_throwf(error_s, lit("vec-set-length: negative length ~s specified"), - length, nao); + uw_throwf(error_s, lit("~a: negative length ~s specified"), + self, length, nao); if (new_length > INT_PTR_MAX - 2) { - uw_throwf(error_s, lit("vec-set-length: cannot extend to length ~s"), - length, nao); + uw_throwf(error_s, lit("~a: cannot extend to length ~s"), + self, length, nao); } if (new_length > old_alloc) { @@ -7206,13 +7209,13 @@ val vec_push(val vec, val item) val length_vec(val vec) { - type_check(vec, VEC); + type_check(lit("length-vec"), vec, VEC); return vec->v.vec[vec_length]; } val size_vec(val vec) { - type_check(vec, VEC); + type_check(lit("size-vec"), vec, VEC); return vec->v.vec[vec_alloc]; } @@ -7264,7 +7267,7 @@ val list_vec(val vec) list_collect_decl (list, ptail); int i, len; - type_check(vec, VEC); + type_check(lit("list-vec"), vec, VEC); len = c_num(vec->v.vec[vec_length]); @@ -7612,7 +7615,7 @@ static val copy_lazy_str(val lstr) val lazy_str_force(val lstr) { val lim, term, pfx; - type_check(lstr, LSTR); + type_check(lit("lazy-str-force"), lstr, LSTR); lim = lstr->ls.props->limit; term = lstr->ls.props->term; pfx = lstr->ls.prefix; @@ -7660,7 +7663,7 @@ val lazy_str_force_upto(val lstr, val index) { uses_or2; val lim, term, ltrm, pfx, len; - type_check(lstr, LSTR); + type_check(lit("lazy-str-force-upto"), lstr, LSTR); lim = lstr->ls.props->limit; term = lstr->ls.props->term; ltrm = length_str(term); @@ -7769,7 +7772,7 @@ val length_str_le(val str, val len) val lazy_str_get_trailing_list(val lstr, val index) { - type_check(lstr, LSTR); + type_check(lit("lazy-str-get-trailing-list"), lstr, LSTR); /* Force lazy string up through the index position */ if (ge(index, length_str(lstr->ls.prefix))) @@ -10615,26 +10618,26 @@ val rangep(val obj) val from(val range) { - type_check(range, RNG); + type_check(lit("from"), range, RNG); return range->rn.from; } val to(val range) { - type_check(range, RNG); + type_check(lit("to"), range, RNG); return range->rn.to; } val set_from(val range, val from) { - type_check(range, RNG); + type_check(lit("set-from"), range, RNG); set(mkloc(range->rn.from, range), from); return range; } val set_to(val range, val to) { - type_check(range, RNG); + type_check(lit("set-to"), range, RNG); set(mkloc(range->rn.to, range), to); return range; } @@ -508,11 +508,11 @@ val typeof(val obj); val subtypep(val sub, val sup); val typep(val obj, val type); seq_info_t seq_info(val cobj); -val throw_mismatch(val obj, type_t); -INLINE val type_check(val obj, type_t typecode) +val throw_mismatch(val self, val obj, type_t); +INLINE val type_check(val self, val obj, type_t typecode) { if (type(obj) != typecode) - throw_mismatch(obj, typecode); + throw_mismatch(self, obj, typecode); return t; } val type_check2(val obj, int, int); @@ -257,6 +257,7 @@ static void small_sigfillset(small_sigset_t *ss) val set_sig_handler(val signo, val lambda) { static struct sigaction blank; + val self = lit("set-sig-handler"); cnum sig = c_num(signo); val old_lambda; small_sigset_t block, saved; @@ -265,7 +266,7 @@ val set_sig_handler(val signo, val lambda) sig_mask(SIG_BLOCK, &block, &saved); if (sig < 0 || sig >= MAX_SIG) - uw_throwf(error_s, lit("set-sig-handler: signal ~s out of range"), sig, nao); + uw_throwf(error_s, lit("~a: signal ~s out of range"), self, sig, nao); old_lambda = sig_lambda[sig]; @@ -281,7 +282,7 @@ val set_sig_handler(val signo, val lambda) } else { struct sigaction sa = blank; - type_check(lambda, FUN); + type_check(self, lambda, FUN); sa.sa_flags = SA_RESTART; sa.sa_handler = sig_handler; |