mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

nucleus: move aux throw/go/tagbody implementations to jump.d

Browse source
This commit is contained in:
Daniel Kochmański 2024-12-11 23:15:31 +01:00
parent e10bb675b0
commit 9c6f31f408
5 changed files with 32 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

31
src/c/cmpaux.d
View file

@ -129,37 +129,6 @@ ecl_aset_bv(cl_object x, cl_index index, int value)
return value;
}
void
cl_throw(cl_object tag)
{
ecl_frame_ptr fr = frs_sch(tag);
if (fr == NULL)
FEcontrol_error("THROW: The catch ~S is undefined.", 1, tag);
ecl_unwind(ecl_process_env(), fr);
}
void
cl_return_from(cl_object block_id, cl_object block_name)
{
ecl_frame_ptr fr = frs_sch(block_id);
if (fr == NULL)
FEcontrol_error("RETURN-FROM: The block ~S with id ~S is missing.",
2, block_name, block_id);
ecl_unwind(ecl_process_env(), fr);
}
void
cl_go(cl_object tag_id, cl_object label)
{
const cl_env_ptr the_env = ecl_process_env();
ecl_frame_ptr fr = frs_sch(tag_id);
if (fr == NULL)
FEcontrol_error("GO: The tagbody ~S is missing.", 1, tag_id);
the_env->values[0] = label;
the_env->nvalues = 1;
ecl_unwind(the_env, fr);
}
cl_object
cl_grab_rest_args(ecl_va_list args)
{

3
src/c/error.d
View file

@ -137,6 +137,9 @@ ecl_exception_handler(cl_object o)
case ECL_EX_F_INVAL:
FEinvalid_function(arg1);
break;
case ECL_EX_S_FMISS:
FEcontrol_error("UNWIND: frame ~s not found.", 1, arg1);
break;
default:
ecl_internal_error("Unknown exception type.");
}

28
src/c/escape.d
View file

@ -35,15 +35,39 @@ continuation is the exit point estabilished by an equivalent of CATCH.
** -------------------------------------------------------------------------- */
cl_object
void
ecl_escape(cl_object continuation)
{
ecl_frame_ptr fr = frs_sch(continuation);
if (!fr) ecl_internal_error("si_fear_handler: continuation not found!");
if (!fr) {
ecl_ferror(ECL_EX_S_FMISS, continuation, ECL_NIL);
}
ecl_unwind(ecl_process_env(), fr);
_ecl_unexpected_return();
}
void
cl_throw(cl_object tag)
{
ecl_escape(tag);
}
void
cl_return_from(cl_object block_id, cl_object block_name)
{
ecl_escape(block_id);
}
void
cl_go(cl_object tag_id, cl_object label)
{
const cl_env_ptr the_env = ecl_process_env();
the_env->values[0] = label;
the_env->nvalues = 1;
ecl_escape(tag_id);
}
/* -- Signaling conditions -------------------------------------------------- **
Low level signals work slightly different from Common Lisp. There are no handler

2
src/h/nucleus.h
View file

@ -40,7 +40,7 @@ cl_env_ptr ecl_spawn_cpu();
void ecl_disown_cpu();
/* control.c */
cl_object ecl_escape(cl_object continuation) ecl_attr_noreturn;
void ecl_escape(cl_object continuation) ecl_attr_noreturn;
cl_object ecl_signal(cl_object condition, cl_object returns, cl_object thread);
cl_object ecl_call_with_handler(cl_object handler, cl_object continuation);

3
src/h/object.h
View file

@ -973,7 +973,8 @@ typedef enum {
ECL_EX_V_BNAME, /* illegal variable name */
ECL_EX_F_NARGS, /* wrong number of arguments */
ECL_EX_F_UNDEF, /* undefined function */
ECL_EX_F_INVAL /* non-function passed as function */
ECL_EX_F_INVAL, /* non-function passed as function */
ECL_EX_S_FMISS /* missing unwind frame (ecl_escape) */
} ecl_ex_type;
#define ECL_EXCEPTIONP(x) ((ECL_IMMEDIATE(x)==0) && ((x)->d.t==t_exception))