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

stacks: move frames stack to a separate structure

Browse source
This commit is contained in:
Daniel Kochmański 2024-04-03 13:17:35 +02:00
parent a624a946b8
commit b42b1532c0
10 changed files with 71 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/alloc_2.d
View file

@ -1156,9 +1156,9 @@ ecl_mark_env(struct cl_env_struct *env)
GC_push_conditional((void *)env->stack, (void *)env->stack_top, 1);
GC_set_mark_bit((void *)env->stack);
}
if (env->frs_top) {
GC_push_conditional((void *)env->frs_org, (void *)(env->frs_top+1), 1);
GC_set_mark_bit((void *)env->frs_org);
if (env->frs_stack.top) {
GC_push_conditional((void *)env->frs_stack.org, (void *)(env->frs_stack.top+1), 1);
GC_set_mark_bit((void *)env->frs_stack.org);
}
if (env->bds_stack.top) {
GC_push_conditional((void *)env->bds_stack.org, (void *)(env->bds_stack.top+1), 1);

4
src/c/error.d
View file

@ -104,8 +104,8 @@ ecl_unrecoverable_error(cl_env_ptr the_env, const char *message)
ecl_unwind(the_env, destination);
}
}
if (the_env->frs_org <= the_env->frs_top) {
destination = ecl_process_env()->frs_org;
if (the_env->frs_stack.org <= the_env->frs_stack.top) {
destination = ecl_process_env()->frs_stack.org;
ecl_unwind(the_env, destination);
} else {
ecl_internal_error("\n;;;\n;;; No frame to jump to\n;;; Aborting ECL\n;;;");

10
src/c/interpreter.d
View file

@ -1089,13 +1089,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
CASE(OP_BLOCK); {
GET_DATA(reg0, vector, data);
reg1 = ecl_make_fixnum(the_env->frame_id++);
reg1 = ecl_make_fixnum(the_env->frs_stack.frame_id++);
bind_frame(lcl_env, reg1, reg0);
THREAD_NEXT;
}
CASE(OP_DO); {
reg0 = ECL_NIL;
reg1 = ecl_make_fixnum(the_env->frame_id++);
reg1 = ecl_make_fixnum(the_env->frs_stack.frame_id++);
bind_frame(lcl_env, reg1, reg0);
THREAD_NEXT;
}
@ -1270,13 +1270,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
vector = (cl_opcode *)ECL_STACK_POP_UNSAFE(the_env);
unwind_lcl(lcl_env, ECL_STACK_POP_UNSAFE(the_env));
reg0 = the_env->values[0];
ECL_STACK_PUSH(the_env, ecl_make_fixnum(the_env->nlj_fr - the_env->frs_top));
ECL_STACK_PUSH(the_env, ecl_make_fixnum(the_env->frs_stack.nlj_fr - the_env->frs_stack.top));
goto PUSH_VALUES;
}
THREAD_NEXT;
}
CASE(OP_PROTECT_NORMAL); {
ecl_bds_unwind(the_env, the_env->frs_top->frs_bds_top_index);
ecl_bds_unwind(the_env, the_env->frs_stack.top->frs_bds_top_index);
ecl_frs_pop(the_env);
(void)ECL_STACK_POP_UNSAFE(the_env);
unwind_lcl(lcl_env, ECL_STACK_POP_UNSAFE(the_env));
@ -1290,7 +1290,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
reg0 = the_env->values[0];
n = ecl_fixnum(ECL_STACK_POP_UNSAFE(the_env));
if (n <= 0)
ecl_unwind(the_env, the_env->frs_top + n);
ecl_unwind(the_env, the_env->frs_stack.top + n);
THREAD_NEXT;
}

4
src/c/main.d
View file

@ -817,8 +817,8 @@ cl_boot(int argc, char **argv)
}
#endif
ECL_SET(@'ext::*program-exit-code*', code);
if (the_env->frs_org <= the_env->frs_top)
ecl_unwind(the_env, the_env->frs_org);
if (the_env->frs_stack.org <= the_env->frs_stack.top)
ecl_unwind(the_env, the_env->frs_stack.org);
si_exit(1, code);
}
@)

64
src/c/stacks.d
View file

@ -640,23 +640,23 @@ si_ihs_env(cl_object arg)
static void
frs_set_size(cl_env_ptr env, cl_index new_size)
{
ecl_frame_ptr old_org = env->frs_org;
cl_index limit = env->frs_top - old_org;
ecl_frame_ptr old_org = env->frs_stack.org;
cl_index limit = env->frs_stack.top - old_org;
if (new_size <= limit) {
FEerror("Cannot shrink frame stack below ~D.", 1,
ecl_make_unsigned_integer(limit));
} else {
cl_index margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
ecl_frame_ptr org;
env->frs_limit_size = new_size - 2*margin;
env->frs_stack.limit_size = new_size - 2*margin;
org = ecl_alloc_atomic(new_size * sizeof(*org));
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
memcpy(org, old_org, (limit + 1) * sizeof(*org));
env->frs_top = org + limit;
env->frs_org = org;
env->frs_limit = org + (new_size - 2*margin);
env->frs_size = new_size;
env->frs_stack.top = org + limit;
env->frs_stack.org = org;
env->frs_stack.limit = org + (new_size - 2*margin);
env->frs_stack.size = new_size;
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
ecl_dealloc(old_org);
@ -672,13 +672,13 @@ frs_overflow(void) /* used as condition in list.d */
";;;\n\n";
cl_env_ptr env = ecl_process_env();
cl_index margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
cl_index size = env->frs_size;
ecl_frame_ptr org = env->frs_org;
cl_index size = env->frs_stack.size;
ecl_frame_ptr org = env->frs_stack.org;
ecl_frame_ptr last = org + size;
if (env->frs_limit >= last) {
if (env->frs_stack.limit >= last) {
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->frs_limit += margin;
env->frs_stack.limit += margin;
si_serror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::frame-stack');
@ -693,14 +693,14 @@ _ecl_frs_push(cl_env_ptr env)
* stray ECL_PROTECT_TAG will lead to segfaults. AO_nop_full is
* needed to ensure that the CPU doesn't reorder the memory
* stores. */
ecl_frame_ptr output = env->frs_top+1;
if (output >= env->frs_limit) {
ecl_frame_ptr output = env->frs_stack.top+1;
if (output >= env->frs_stack.limit) {
frs_overflow();
output = env->frs_top+1;
output = env->frs_stack.top+1;
}
output->frs_val = ECL_DUMMY_TAG;
AO_nop_full();
++env->frs_top;
++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_sp = ECL_STACK_INDEX(env);
@ -710,8 +710,8 @@ _ecl_frs_push(cl_env_ptr env)
void
ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr)
{
env->nlj_fr = fr;
ecl_frame_ptr top = env->frs_top;
env->frs_stack.nlj_fr = fr;
ecl_frame_ptr top = env->frs_stack.top;
while (top != fr && top->frs_val != ECL_PROTECT_TAG){
top->frs_val = ECL_DUMMY_TAG;
--top;
@ -719,8 +719,8 @@ ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr)
env->ihs_top = top->frs_ihs;
ecl_bds_unwind(env, top->frs_bds_top_index);
ECL_STACK_SET_INDEX(env, top->frs_sp);
env->frs_top = top;
ecl_longjmp(env->frs_top->frs_jmpbuf, 1);
env->frs_stack.top = top;
ecl_longjmp(env->frs_stack.top->frs_jmpbuf, 1);
/* never reached */
}
@ -729,7 +729,7 @@ frs_sch (cl_object frame_id)
{
cl_env_ptr env = ecl_process_env();
ecl_frame_ptr top;
for (top = env->frs_top; top >= env->frs_org; top--)
for (top = env->frs_stack.top; top >= env->frs_stack.org; top--)
if (top->frs_val == frame_id)
return(top);
return(NULL);
@ -740,8 +740,8 @@ get_frame_ptr(cl_object x)
{
if (ECL_FIXNUMP(x)) {
cl_env_ptr env = ecl_process_env();
ecl_frame_ptr p = env->frs_org + ecl_fixnum(x);
if (env->frs_org <= p && p <= env->frs_top)
ecl_frame_ptr p = env->frs_stack.org + ecl_fixnum(x);
if (env->frs_stack.org <= p && p <= env->frs_stack.top)
return p;
}
FEerror("~S is an illegal frs index.", 1, x);
@ -751,7 +751,7 @@ cl_object
si_frs_top()
{
cl_env_ptr env = ecl_process_env();
ecl_return1(env, ecl_make_fixnum(env->frs_top - env->frs_org));
ecl_return1(env, ecl_make_fixnum(env->frs_stack.top - env->frs_stack.org));
}
cl_object
@ -782,9 +782,11 @@ si_sch_frs_base(cl_object fr, cl_object ihs)
ecl_frame_ptr x;
cl_index y = ecl_to_size(ihs);
for (x = get_frame_ptr(fr);
x <= env->frs_top && x->frs_ihs->index < y;
x <= env->frs_stack.top && x->frs_ihs->index < y;
x++);
ecl_return1(env, ((x > env->frs_top) ? ECL_NIL : ecl_make_fixnum(x - env->frs_org)));
ecl_return1(env, ((x > env->frs_stack.top)
? ECL_NIL
: ecl_make_fixnum(x - env->frs_stack.org)));
}
/* ------------------------- INITIALIZATION --------------------------- */
@ -827,7 +829,7 @@ si_get_limit(cl_object type)
cl_env_ptr env = ecl_process_env();
cl_index output = 0;
if (type == @'ext::frame-stack')
output = env->frs_limit_size;
output = env->frs_stack.limit_size;
else if (type == @'ext::binding-stack')
output = env->bds_stack.limit_size;
else if (type == @'ext::c-stack')
@ -847,7 +849,7 @@ si_reset_margin(cl_object type)
{
cl_env_ptr env = ecl_process_env();
if (type == @'ext::frame-stack')
frs_set_size(env, env->frs_size);
frs_set_size(env, env->frs_stack.size);
else if (type == @'ext::binding-stack')
ecl_bds_set_size(env, env->bds_stack.size);
else if (type == @'ext::c-stack')
@ -866,10 +868,10 @@ init_stacks(cl_env_ptr env)
/* frame stack */
margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
size = ecl_option_values[ECL_OPT_FRAME_STACK_SIZE] + 2 * margin;
env->frs_size = size;
env->frs_org = (ecl_frame_ptr)ecl_alloc_atomic(size * sizeof(*env->frs_org));
env->frs_top = env->frs_org-1;
env->frs_limit = &env->frs_org[size - 2*margin];
env->frs_stack.size = size;
env->frs_stack.org = (ecl_frame_ptr)ecl_alloc_atomic(size * sizeof(*env->frs_stack.org));
env->frs_stack.top = env->frs_stack.org-1;
env->frs_stack.limit = &env->frs_stack.org[size - 2*margin];
/* bind stack */
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE] + 2 * margin;

2
src/c/threads/thread.d
View file

@ -588,7 +588,7 @@ mp_exit_process(void)
UNWIND-PROTECT.
*/
const cl_env_ptr the_env = ecl_process_env();
ecl_unwind(the_env, the_env->frs_org);
ecl_unwind(the_env, the_env->frs_stack.org);
/* Never reached */
}

4
src/c/unixint.d
View file

@ -398,14 +398,14 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
* INV: Due to the stack safety areas we don't need to check
* for env->frs/bds_limit */
struct ecl_frame top_frame;
memcpy(&top_frame, env->frs_top+1, sizeof(struct ecl_frame));
memcpy(&top_frame, env->frs_stack.top+1, sizeof(struct ecl_frame));
struct ecl_bds_frame top_binding;
memcpy(&top_binding, env->bds_stack.top+1, sizeof(struct ecl_bds_frame));
/* Finally we can handle the queued signals ... */
handle_all_queued(env);
/* ... and restore everything again */
memcpy(env->bds_stack.top+1, &top_binding, sizeof(struct ecl_bds_frame));
memcpy(env->frs_top+1, &top_frame, sizeof(struct ecl_frame));
memcpy(env->frs_stack.top+1, &top_frame, sizeof(struct ecl_frame));
env->stack_top--;
ecl_clear_bignum_registers(env);
memcpy(env->big_register, big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object));

2
src/cmp/cmpbackend-cxx/cmppass2-cont.lsp
View file

@ -149,7 +149,7 @@
(wt-nl "volatile bool unwinding = FALSE;")
(wt-nl "ecl_frame_ptr next_fr;")
(with-unwind-frame ("ECL_PROTECT_TAG")
(wt-nl " unwinding = TRUE; next_fr=cl_env_copy->nlj_fr;")
(wt-nl " unwinding = TRUE; next_fr=cl_env_copy->frs_stack.nlj_fr;")
(let ((*destination* 'VALUEZ))
(c2expr* form)))
(wt-nl "ecl_frs_pop(cl_env_copy);")

33
src/h/external.h
View file

@ -19,9 +19,23 @@ struct ecl_binding_stack {
#endif
cl_index size;
cl_index limit_size;
struct ecl_bds_frame * org;
struct ecl_bds_frame * top;
struct ecl_bds_frame * limit;
struct ecl_bds_frame *org;
struct ecl_bds_frame *top;
struct ecl_bds_frame *limit;
};
/* The FRames Stack (FRS) is a list of frames or jump points, and it is used by
* different high-level constructs (BLOCK, TAGBODY, CATCH...) to set return
* points. */
struct ecl_frames_stack {
struct ecl_frame *nlj_fr;
cl_index frame_id;
cl_index size;
cl_index limit_size;
struct ecl_frame *org;
struct ecl_frame *top;
struct ecl_frame *limit;
};
/*
@ -56,6 +70,7 @@ 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
@ -64,18 +79,6 @@ struct cl_env_struct {
*/
struct ecl_ihs_frame *ihs_top;
/*
* The FRames Stack (FRS) is a list of frames or jump points, and it
* is used by different high-level constructs (BLOCK, TAGBODY, CATCH...)
* to set return points.
*/
cl_index frs_size;
cl_index frs_limit_size;
struct ecl_frame *frs_org;
struct ecl_frame *frs_top;
struct ecl_frame *frs_limit;
struct ecl_frame *nlj_fr;
cl_index frame_id;
/*
* The following pointers to the C Stack are used to ensure that a

8
src/h/stacks.h
View file

@ -293,8 +293,8 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(cl_env_ptr);
int __ecl_frs_push_result = ecl_setjmp(__frame->frs_jmpbuf); \
ecl_enable_interrupts_env(env)
#define ecl_frs_pop(env) ((env)->frs_top--)
#define ecl_frs_pop_n(env,n) ((env)->frs_top-=n)
#define ecl_frs_pop(env) ((env)->frs_stack.top--)
#define ecl_frs_pop_n(env,n) ((env)->frs_stack.top-=n)
/*******************
* ARGUMENTS STACK
@ -430,7 +430,7 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(cl_env_ptr);
cl_index __nr; \
ecl_frs_push(__the_env,ECL_PROTECT_TAG); \
if (__ecl_frs_push_result) { \
__unwinding=1; __next_fr=__the_env->nlj_fr; \
__unwinding=1; __next_fr=__the_env->frs_stack.nlj_fr; \
} else {
#define ECL_UNWIND_PROTECT_EXIT \
@ -455,7 +455,7 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(cl_env_ptr);
ecl_check_pending_interrupts(__the_env); \
if (__unwinding) ecl_unwind(__the_env,__next_fr); } while(0)
#define ECL_NEW_FRAME_ID(env) ecl_make_fixnum(env->frame_id++)
#define ECL_NEW_FRAME_ID(env) ecl_make_fixnum(env->frs_stack.frame_id++)
#define ECL_BLOCK_BEGIN(the_env,id) do { \
const cl_object __id = ECL_NEW_FRAME_ID(the_env); \