mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-10 07:00:20 -07:00
Code Issues Projects Releases Packages Wiki Activity

exceptions: dispatch signals exceptions (not conditions)

Browse source
This commit is contained in:
Daniel Kochmański 2026-03-03 14:57:15 +01:00
parent 827fbfc268
commit 96de2e24ad
4 changed files with 25 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

24
src/c/apply.d
View file

@ -22,7 +22,7 @@ ecl_function_dispatch(cl_env_ptr env, cl_object x)
{
cl_object fun = x;
if (ecl_unlikely(fun == ECL_NIL))
FEundefined_function(x);
ecl_ferror(ECL_EX_F_UNDEF, fun, ECL_NIL);
switch (ecl_t_of(fun)) {
case t_cfunfixed:
env->function = fun;
@ -47,7 +47,7 @@ ecl_function_dispatch(cl_env_ptr env, cl_object x)
env->function = fun;
return fun->bclosure.entry;
default:
FEinvalid_function(x);
ecl_ferror(ECL_EX_F_INVAL, fun, ECL_NIL);
}
_ecl_unexpected_return();
}
@ -75,13 +75,15 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x)
AGAIN:
frame->frame.env->function = fun;
if (ecl_unlikely(fun == ECL_NIL))
FEundefined_function(x);
ecl_ferror(ECL_EX_F_UNDEF, x, ECL_NIL);
switch (ecl_t_of(fun)) {
case t_cfunfixed:
if (ecl_unlikely(narg != (cl_index)fun->cfun.narg))
FEwrong_num_arguments(fun);
ret = APPLY_fixed(narg, fun->cfunfixed.entry_fixed, sp);
break;
if (fun->cfunfixed.entry_fixed != NULL) {
if (ecl_unlikely(narg != (cl_index)fun->cfun.narg))
ecl_ferror(ECL_EX_F_NARGS, fun, ECL_NIL);
ret = APPLY_fixed(narg, fun->cfunfixed.entry_fixed, sp);
break;
}
case t_cfun:
ret = APPLY(narg, fun->cfun.entry, sp);
break;
@ -102,12 +104,12 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x)
ret = APPLY(narg, fun->instance.entry, sp);
break;
default:
FEinvalid_function(fun);
ecl_ferror(ECL_EX_F_INVAL, fun, ECL_NIL);
}
break;
case t_symbol:
if (ecl_unlikely(!ECL_FBOUNDP(fun)))
FEundefined_function(fun);
ecl_ferror(ECL_EX_F_UNDEF, fun, ECL_NIL);
fun = ECL_SYM_FUN(fun);
goto AGAIN;
case t_bytecodes:
@ -117,7 +119,7 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x)
ret = ecl_interpret(frame, fun->bclosure.lex, fun->bclosure.code);
break;
default:
FEinvalid_function(x);
ecl_ferror(ECL_EX_F_INVAL, x, ECL_NIL);
}
frame->frame.env->stack_frame = NULL; /* for gc's sake */
return ret;
@ -784,7 +786,7 @@ APPLY_fixed(cl_narg n, cl_object (*fn)(), cl_object *x)
x[50],x[51],x[52],x[53],x[54],x[55],x[56],
x[57],x[58],x[59],x[60],x[61],x[62]);
default:
FEprogram_error("Too many arguments", 0);
ecl_ferror(ECL_EX_F_EARGS, ecl_make_fixnum(n), ECL_NIL);
}
_ecl_unexpected_return();
}

12
src/c/error.d
View file

@ -131,6 +131,9 @@ ecl_exception_handler(cl_object o)
case ECL_EX_F_NARGS:
FEwrong_num_arguments(arg1);
break;
case ECL_EX_F_EARGS:
FEwrong_num_arguments_exceed(arg1);
break;
case ECL_EX_F_UNDEF:
FEundefined_function(arg1);
break;
@ -459,8 +462,13 @@ void
FEwrong_num_arguments(cl_object fun)
{
fun = cl_symbol_or_object(fun);
FEprogram_error("Wrong number of arguments passed to function ~S.",
1, fun);
FEprogram_error("Wrong number of arguments passed to function ~S.", 1, fun);
}
void
FEwrong_num_arguments_exceed(cl_object n)
{
FEprogram_error("Too many arguments: ~S.", 1, n);
}
void

1
src/h/external.h
View file

@ -574,6 +574,7 @@ extern ECL_API void FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_ob
extern ECL_API void FEwrong_type_key_arg(cl_object function, cl_object keyo, cl_object type, cl_object value) ecl_attr_noreturn;
extern ECL_API void FEwrong_num_arguments(cl_object fun) ecl_attr_noreturn;
extern ECL_API void FEwrong_num_arguments_anonym(void) ecl_attr_noreturn;
extern ECL_API void FEwrong_num_arguments_exceed(cl_object n) ecl_attr_noreturn;
extern ECL_API void FEwrong_index(cl_object function, cl_object a, int which, cl_object ndx, cl_index nonincl_limit) ecl_attr_noreturn;
extern ECL_API void FEunbound_variable(cl_object sym) ecl_attr_noreturn;
extern ECL_API void FEinvalid_macro_call(cl_object obj) ecl_attr_noreturn;

1
src/h/object.h
View file

@ -980,6 +980,7 @@ typedef enum {
ECL_EX_V_UNBND, /* unbound variable */
ECL_EX_V_BNAME, /* illegal variable name */
ECL_EX_F_NARGS, /* wrong number of arguments */
ECL_EX_F_EARGS, /* too many arguments */
ECL_EX_F_UNDEF, /* undefined function */
ECL_EX_F_INVAL /* non-function passed as function */
} ecl_ex_type;