summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--arith.c2
-rw-r--r--eval.c32
-rw-r--r--gc.c2
-rw-r--r--lib.c69
-rw-r--r--lib.h6
-rw-r--r--signal.c5
6 files changed, 60 insertions, 56 deletions
diff --git a/arith.c b/arith.c
index 75ae66dd..e75d4384 100644
--- a/arith.c
+++ b/arith.c
@@ -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);
diff --git a/eval.c b/eval.c
index 1555956d..c07ea8d4 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
}
diff --git a/gc.c b/gc.c
index 15384794..1359ea0f 100644
--- a/gc.c
+++ b/gc.c
@@ -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);
diff --git a/lib.c b/lib.c
index 1c824f6c..d5379143 100644
--- a/lib.c
+++ b/lib.c
@@ -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;
}
diff --git a/lib.h b/lib.h
index 0868d31c..11228ced 100644
--- a/lib.h
+++ b/lib.h
@@ -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);
diff --git a/signal.c b/signal.c
index 39e0dac2..a9491d0c 100644
--- a/signal.c
+++ b/signal.c
@@ -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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-20 14:20:38 +0000