andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Throw exceptions rather than asserts. 

* lib.c (error): Throw instead of assert.
  (check_formals, check_apply): Update.
* mes.c (scm_symbol_unbound_variable, scm_symbol_not_a_pair,
  scm_symbol_system_error, scm_symbol_wrong_number_of_args,
  scm_symbol_wrong_type_arg, scm_symbol_unbound_variable): New symbols.
  (car, cdr, set_cdr_x, set_env_x, eval_apply, gc_up_arena): Update.
This commit is contained in:
Jan Nieuwenhuizen 2016-12-28 22:26:33 +01:00
parent 2675f711a3
commit cb1fa49767
2 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lib.c
View File

@ -71,19 +71,19 @@ string_to_cstring (SCM s)
return buf;
}
int
error (char const* msg, SCM x)
SCM
error (SCM key, SCM x)
{
fprintf (stderr, msg);
if (x) stderr_ (x);
fprintf (stderr, "\n");
assert(!msg);
SCM throw;
if ((throw = assq_ref_cache (cell_symbol_throw, r0)) != cell_undefined)
return apply (throw, cons (key, cons (x, cell_nil)), r0);
assert (!"error");
}
SCM
assert_defined (SCM x, SCM e)
{
if (e == cell_undefined) error ("eval: unbound variable: ", x);
if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
return e;
}
@ -96,7 +96,8 @@ check_formals (SCM f, SCM formals, SCM args)
{
char buf[1024];
sprintf (buf, "apply: wrong number of arguments; expected: %d, got: %d: ", flen, alen);
error (buf, f);
SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_number_of_args, cons (e, f));
}
return cell_unspecified;
}
@ -106,11 +107,12 @@ check_apply (SCM f, SCM e)
{
char const* type = 0;
if (f == cell_f || f == cell_t) type = "bool";
if (f == cell_nil) type = "nil";
if (f == cell_unspecified) type = "*unspecified*";
if (f == cell_undefined) type = "*undefined*";
if (TYPE (f) == CHAR) type = "char";
if (TYPE (f) == NUMBER) type = "number";
if (TYPE (f) == STRING) type = "string";
if (f == cell_unspecified) type = "*unspecified*";
if (f == cell_undefined) type = "*undefined*";
if (type)
{
@ -119,7 +121,8 @@ check_apply (SCM f, SCM e)
fprintf (stderr, " [");
stderr_ (e);
fprintf (stderr, "]\n");
error (buf, f);
SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_type_arg, cons (e, f));
}
return cell_unspecified;
}

19
mes.c
View File

@ -114,7 +114,13 @@ scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"};
scm scm_symbol_read_input_file = {SYMBOL, "read-input-file"};
scm scm_symbol_write = {SYMBOL, "write"};
scm scm_symbol_display = {SYMBOL, "display"};
scm scm_symbol_throw = {SYMBOL, "throw"};
scm scm_symbol_not_a_pair = {SYMBOL, "not-a-pair"};
scm scm_symbol_system_error = {SYMBOL, "system-error"};
scm scm_symbol_wrong_number_of_args = {SYMBOL, "wrong-number-of-args"};
scm scm_symbol_wrong_type_arg = {SYMBOL, "wrong-type-arg"};
scm scm_symbol_unbound_variable = {SYMBOL, "unbound-variable"};
scm scm_symbol_argv = {SYMBOL, "%argv"};
scm scm_symbol_mes_prefix = {SYMBOL, "%prefix"};
@ -214,7 +220,6 @@ SCM r3 = 0; // continuation
#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0)
#define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0)
int error (char const* msg, SCM x);
SCM vm_call (function0_t f, SCM p1, SCM a);
SCM
@ -269,14 +274,14 @@ cons (SCM x, SCM y)
SCM
car (SCM x)
{
if (TYPE (x) != PAIR) error ("car: not pair: ", x);
if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
return CAR (x);
}
SCM
cdr (SCM x)
{
if (TYPE (x) != PAIR) error ("cdr: not pair: ", x);
if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
return CDR (x);
}
SCM
@ -330,7 +335,7 @@ set_car_x (SCM x, SCM e)
SCM
set_cdr_x (SCM x, SCM e)
{
if (TYPE (x) != PAIR) error ("set-cdr!: not pair: ", x);
if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
CDR (x) = e;
return cell_unspecified;
}
@ -339,7 +344,7 @@ SCM
set_env_x (SCM x, SCM e, SCM a)
{
SCM p = assert_defined (x, assq (x, a));
if (TYPE (p) != PAIR) error ("set-env!: not pair: ", x);
if (TYPE (p) != PAIR) error (cell_symbol_not_a_pair, cons (p, x));
return set_cdr_x (p, e);
}
@ -490,7 +495,7 @@ eval_apply ()
r1 = cdr (r1);
goto call_with_current_continuation;
}
default: error ("cannot apply special: ", car (r1));
default: check_apply (cell_f, car (r1));
}
}
case SYMBOL:
@ -926,7 +931,7 @@ gc_up_arena ()
{
ARENA_SIZE *= 2;
void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(scm));
if (!p) error (strerror (errno), MAKE_NUMBER (g_free));
if (!p) error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
g_cells = (scm*)p;
g_cells++;
gc_init_news ();