mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 05:21:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

stacks: move invocation history stack to a separate structure

Browse source
This commit is contained in:
Daniel Kochmański 2024-04-03 13:22:14 +02:00
parent b42b1532c0
commit 5260cbc7de
4 changed files with 24 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/c/error.d
View file

@ -287,7 +287,7 @@ FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
if (!Null(function) && env->ihs_stack.top && env->ihs_stack.top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
}
si_signal_simple_error(8,
@ -311,7 +311,7 @@ FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_objec
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
if (!Null(function) && env->ihs_stack.top && env->ihs_stack.top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
}
si_signal_simple_error(8,
@ -337,7 +337,7 @@ FEwrong_type_key_arg(cl_object function, cl_object key, cl_object value, cl_obje
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
key = cl_symbol_or_object(key);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
if (!Null(function) && env->ihs_stack.top && env->ihs_stack.top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
}
si_signal_simple_error(8,
@ -368,7 +368,7 @@ FEwrong_index(cl_object function, cl_object a, int which, cl_object ndx,
cl_env_ptr env = ecl_process_env();
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
if (!Null(function) && env->ihs_stack.top && env->ihs_stack.top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
}
cl_error(9,

10
src/c/stacks.d
View file

@ -585,7 +585,7 @@ static ecl_ihs_ptr
get_ihs_ptr(cl_index n)
{
cl_env_ptr env = ecl_process_env();
ecl_ihs_ptr p = env->ihs_top;
ecl_ihs_ptr p = env->ihs_stack.top;
if (n > p->index)
FEerror("~D is an illegal IHS index.", 1, ecl_make_fixnum(n));
while (n < p->index)
@ -597,7 +597,7 @@ cl_object
si_ihs_top(void)
{
cl_env_ptr env = ecl_process_env();
ecl_return1(env, ecl_make_fixnum(env->ihs_top->index));
ecl_return1(env, ecl_make_fixnum(env->ihs_stack.top->index));
}
cl_object
@ -702,7 +702,7 @@ _ecl_frs_push(cl_env_ptr env)
AO_nop_full();
++env->frs_stack.top;
output->frs_bds_top_index = env->bds_stack.top - env->bds_stack.org;
output->frs_ihs = env->ihs_top;
output->frs_ihs = env->ihs_stack.top;
output->frs_sp = ECL_STACK_INDEX(env);
return output;
}
@ -716,7 +716,7 @@ ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr)
top->frs_val = ECL_DUMMY_TAG;
--top;
}
env->ihs_top = top->frs_ihs;
env->ihs_stack.top = top->frs_ihs;
ecl_bds_unwind(env, top->frs_bds_top_index);
ECL_STACK_SET_INDEX(env, top->frs_sp);
env->frs_stack.top = top;
@ -880,7 +880,7 @@ init_stacks(cl_env_ptr env)
env->bds_stack.top = env->bds_stack.org-1;
env->bds_stack.limit = &env->bds_stack.org[size - 2*margin];
/* ihs stack */
env->ihs_top = &ihs_org;
env->ihs_stack.top = &ihs_org;
ihs_org.function = ECL_NIL;
ihs_org.lex_env = ECL_NIL;
ihs_org.index = 0;

17
src/h/external.h
View file

@ -38,6 +38,12 @@ struct ecl_frames_stack {
struct ecl_frame *limit;
};
/* The Invocation History Stack (IHS) keeps a list of the names of the functions
* that are invoked, together with their lexical environments. */
struct ecl_history_stack {
struct ecl_ihs_frame *top;
};
/*
* Per-thread data.
*/
@ -70,15 +76,8 @@ struct cl_env_struct {
cl_object *stack_limit;
struct ecl_binding_stack bds_stack;
struct ecl_frames_stack frs_stack;
/*
* The Invocation History Stack (IHS) keeps a list of the names of the
* functions that are invoked, together with their lexical
* environments.
*/
struct ecl_ihs_frame *ihs_top;
struct ecl_frames_stack frs_stack;
struct ecl_history_stack ihs_stack;
/*
* The following pointers to the C Stack are used to ensure that a

14
src/h/stacks.h
View file

@ -240,18 +240,18 @@ typedef struct ecl_ihs_frame {
#define ecl_ihs_push(env,rec,fun,lisp_env) do { \
const cl_env_ptr __the_env = (env); \
ecl_ihs_ptr const r = (ecl_ihs_ptr const)(rec); \
r->next=__the_env->ihs_top; \
r->function=(fun); \
r->lex_env=(lisp_env); \
r->index=__the_env->ihs_top->index+1; \
r->next=__the_env->ihs_stack.top; \
r->function=(fun); \
r->lex_env=(lisp_env); \
r->index=__the_env->ihs_stack.top->index+1; \
r->bds=__the_env->bds_stack.top - __the_env->bds_stack.org; \
__the_env->ihs_top = r; \
__the_env->ihs_stack.top = r; \
} while(0)
#define ecl_ihs_pop(env) do { \
const cl_env_ptr __the_env = (env); \
ecl_ihs_ptr r = __the_env->ihs_top; \
if (r) __the_env->ihs_top = r->next; \
ecl_ihs_ptr r = __the_env->ihs_stack.top; \
if (r) __the_env->ihs_stack.top = r->next; \
} while(0)
/***************