From 2f9ce70e8f2872aa07ed2bf713ea3fb4a8d678f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Thu, 8 May 2025 15:45:00 +0200 Subject: [PATCH] stack frames: dereference directly to env->stack Previously we've cached the stack base and dereferenced from there, but when the stack is resized, this reference is invalidated and there is no good fix it in all frames (we don't store back references). This commit replaces pointers with indexes, so the stack frame is always displaced onto the current lisp stack. --- src/c/alloc_2.d | 4 +--- src/c/clos/gfun.d | 10 +++++----- src/c/compiler.d | 4 +++- src/c/eval.d | 6 +++--- src/c/interpreter.d | 32 +++++++++++++++++++------------- src/c/stacks.d | 21 +++++++++++---------- src/h/internal.h | 14 +++++++++----- src/h/object.h | 7 +++---- src/h/stacks.h | 23 ++++++++++++++--------- 9 files changed, 68 insertions(+), 53 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 7d5305e4b..6c55be548 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -551,7 +551,7 @@ void init_type_info (void) #endif init_tm(t_codeblock, "CODEBLOCK", sizeof(struct ecl_codeblock), -1); init_tm(t_foreign, "FOREIGN", sizeof(struct ecl_foreign), 2); - init_tm(t_frame, "STACK-FRAME", sizeof(struct ecl_stack_frame), 2); + init_tm(t_frame, "STACK-FRAME", sizeof(struct ecl_stack_frame), 0); init_tm(t_weak_pointer, "WEAK-POINTER", sizeof(struct ecl_weak_pointer), 0); #ifdef ECL_SSE2 init_tm(t_sse_pack, "SSE-PACK", sizeof(struct ecl_sse_pack), 0); @@ -709,8 +709,6 @@ void init_type_info (void) to_bitmap(&o, &(o.foreign.data)) | to_bitmap(&o, &(o.foreign.tag)); type_info[t_frame].descriptor = - to_bitmap(&o, &(o.frame.stack)) | - to_bitmap(&o, &(o.frame.base)) | to_bitmap(&o, &(o.frame.env)); type_info[t_weak_pointer].descriptor = 0; #ifdef ECL_SSE2 diff --git a/src/c/clos/gfun.d b/src/c/clos/gfun.d index 7a1598736..19c3e483a 100644 --- a/src/c/clos/gfun.d +++ b/src/c/clos/gfun.d @@ -113,7 +113,7 @@ si_generic_function_p(cl_object x) static cl_object fill_spec_vector(cl_object vector, cl_object frame, cl_object gf) { - cl_object *args = frame->frame.base; + cl_object *args = ECL_STACK_FRAME_PTR(frame); cl_index narg = frame->frame.size; cl_object spec_how_list = GFUN_SPEC(gf); cl_object *argtype = vector->vector.self.t; @@ -148,8 +148,8 @@ static cl_object frame_to_list(cl_object frame) { cl_object arglist, *p; - for (p = frame->frame.base + frame->frame.size, arglist = ECL_NIL; - p != frame->frame.base; ) { + cl_object *base = ECL_STACK_FRAME_PTR(frame); + for (p = base + frame->frame.size, arglist = ECL_NIL; p != base; ) { arglist = CONS(*(--p), arglist); } return arglist; @@ -159,8 +159,8 @@ static cl_object frame_to_classes(cl_object frame) { cl_object arglist, *p; - for (p = frame->frame.base + frame->frame.size, arglist = ECL_NIL; - p != frame->frame.base; ) { + cl_object *base = ECL_STACK_FRAME_PTR(frame); + for (p = base + frame->frame.size, arglist = ECL_NIL; p != base; ) { arglist = CONS(cl_class_of(*(--p)), arglist); } return arglist; diff --git a/src/c/compiler.d b/src/c/compiler.d index fecce2c65..ee76b0950 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -2737,8 +2737,10 @@ eval_nontrivial_form(cl_env_ptr env, cl_object form) { cl_object bytecodes; struct ecl_stack_frame frame; frame.t = t_frame; - frame.stack = frame.base = 0; + frame.opened = 0; + frame.base = 0; frame.size = 0; + frame.sp = 0; frame.env = env; env->nvalues = 0; env->values[0] = ECL_NIL; diff --git a/src/c/eval.d b/src/c/eval.d index 5ae57175c..237f54660 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -19,7 +19,7 @@ cl_object * _ecl_va_sp(cl_narg narg) { - return ecl_process_env()->stack_frame->frame.base + narg; + return ECL_STACK_FRAME_PTR(ecl_process_env()->stack_frame) + narg; } /* Calling conventions: @@ -34,7 +34,7 @@ _ecl_va_sp(cl_narg narg) cl_object ecl_apply_from_stack_frame(cl_object frame, cl_object x) { - cl_object *sp = frame->frame.base; + cl_object *sp = ECL_STACK_FRAME_PTR(frame); cl_index narg = frame->frame.size; cl_object fun = x; cl_object ret; @@ -155,7 +155,7 @@ cl_funcall(cl_narg narg, cl_object function, ...) if (ecl_t_of(lastarg) == t_frame) { /* This could be replaced with a memcpy() */ for (i = 0; i < lastarg->frame.size; i++) { - ecl_stack_frame_push(frame, lastarg->frame.base[i]); + ecl_stack_frame_push(frame, ECL_STACK_FRAME_REF(lastarg, i)); } } else loop_for_in (lastarg) { if (ecl_unlikely(i >= ECL_CALL_ARGUMENTS_LIMIT)) { diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 0389a4d41..5e3622d47 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -128,13 +128,14 @@ VEclose_around_arg_type() #define bind_frame(env, id, name) bind_lcl(env, CONS(id, name)) #define unbind_lcl(env, n) drop_lcl(env, n) -#define tangle_lcl(stack) ecl_cast_ptr(cl_object,stack->frame.sp) -#define unwind_lcl(stack, where) (stack->frame.sp = ecl_cast_ptr(cl_object*,where)) +#define tangle_lcl(stack) ecl_make_fixnum(stack->frame.sp) +#define unwind_lcl(stack, where) (stack->frame.sp = ecl_fixnum(where)) static void push_lcl(cl_object stack, cl_object new) { - *(stack->frame.sp++) = new; + *ECL_STACK_FRAME_TOP(stack) = new; + stack->frame.sp++; } static void @@ -335,11 +336,14 @@ call_stepper(cl_env_ptr the_env, cl_object form, cl_object delta) #define INTERPRET_FUNCALL(reg0, the_env, frame, narg, fun) { \ cl_index __n = narg; \ + cl_index __b = ECL_STACK_INDEX(the_env) - __n; \ SETUP_ENV(the_env); \ - frame.stack = the_env->stack; \ - frame.base = the_env->stack_top - (frame.size = __n); \ + frame.opened = 1; \ + frame.base = __b; \ + frame.size = __n; \ + frame.sp = __b; \ reg0 = ecl_apply_from_stack_frame((cl_object)&frame, fun); \ - the_env->stack_top -= __n; } + ecl_stack_frame_close((cl_object)&frame); } /* -------------------- THE INTERPRETER -------------------- */ @@ -365,8 +369,10 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) ecl_ihs_push(the_env, &ihs, bytecodes, closure); ecl_stack_frame_open(the_env, lcl_env, nlcl); frame_aux.t = t_frame; - frame_aux.stack = frame_aux.base = 0; + frame_aux.opened = 0; + frame_aux.base = 0; frame_aux.size = 0; + frame_aux.sp = 0; frame_aux.env = the_env; BEGIN_SWITCH { CASE(OP_NOP); { @@ -602,7 +608,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) if (ecl_unlikely(frame_index >= frame->frame.size)) { VEwrong_num_arguments(bytecodes->bytecodes.name); } - reg0 = frame->frame.base[frame_index++]; + reg0 = ECL_STACK_FRAME_REF(frame, frame_index++); THREAD_NEXT; } /* OP_POPOPT @@ -614,7 +620,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) if (frame_index >= frame->frame.size) { reg0 = ECL_NIL; } else { - ECL_STACK_PUSH(the_env,frame->frame.base[frame_index++]); + ECL_STACK_PUSH(the_env, ECL_STACK_FRAME_REF(frame, frame_index++)); reg0 = ECL_T; } THREAD_NEXT; @@ -631,8 +637,8 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) Makes a list out of the remaining arguments. */ CASE(OP_POPREST); { - cl_object *first = frame->frame.base + frame_index; - cl_object *last = frame->frame.base + frame->frame.size; + cl_object *first = ECL_STACK_FRAME_PTR(frame) + frame_index; + cl_object *last = ECL_STACK_FRAME_PTR(frame) + frame->frame.size; for (reg0 = ECL_NIL; last > first; ) { reg0 = CONS(*(--last), reg0); } @@ -645,7 +651,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) cl_object keys_list, aok, *first, *last; cl_index count; GET_DATA(keys_list, vector, data); - first = frame->frame.base + frame_index; + first = ECL_STACK_FRAME_PTR(frame) + frame_index; count = frame->frame.size - frame_index; last = first + count; if (ecl_unlikely(count & 1)) { @@ -733,7 +739,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) CASE(OP_LABELS); { cl_index idx, nfun; cl_object fun; - cl_object *sp = lcl_env->frame.sp; + cl_object *sp = ECL_STACK_FRAME_TOP(lcl_env); GET_OPARG(nfun, vector); /* Create closures. */ for(idx = 0; idxstack_top; + cl_index bindex; if (size) { if ((env->stack_limit - base) < size) { base = ecl_stack_set_size(env, env->stack_size + size); } } + bindex = ECL_STACK_INDEX(env); f->frame.t = t_frame; - f->frame.stack = env->stack; - f->frame.base = base; + f->frame.opened = 1; + f->frame.base = bindex; f->frame.size = size; - f->frame.sp = base; + f->frame.sp = bindex; f->frame.env = env; env->stack_top = (base + size); return f; @@ -243,8 +245,7 @@ ecl_stack_frame_push(cl_object f, cl_object o) } env->stack_top = ++top; *(top-1) = o; - f->frame.base = top - (++(f->frame.size)); - f->frame.stack = env->stack; + f->frame.size++; } void @@ -252,8 +253,7 @@ ecl_stack_frame_push_values(cl_object f) { cl_env_ptr env = f->frame.env; ecl_stack_push_values(env); - f->frame.base = env->stack_top - (f->frame.size += env->nvalues); - f->frame.stack = env->stack; + f->frame.size += env->nvalues; } cl_object @@ -265,7 +265,7 @@ ecl_stack_frame_pop_values(cl_object f) env->nvalues = n; env->values[0] = o = ECL_NIL; while (n--) { - env->values[n] = o = f->frame.base[n]; + env->values[n] = o = ECL_STACK_FRAME_REF(f, n); } return o; } @@ -273,8 +273,9 @@ ecl_stack_frame_pop_values(cl_object f) void ecl_stack_frame_close(cl_object f) { - if (f->frame.stack) { - ECL_STACK_SET_INDEX(f->frame.env, f->frame.base - f->frame.stack); + if (f->frame.opened) { + f->frame.opened = 0; + ECL_STACK_SET_INDEX(f->frame.env, f->frame.base); } } diff --git a/src/h/internal.h b/src/h/internal.h index 8fd9c8a4b..296f7520b 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -343,10 +343,12 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, #define ECL_STACK_FRAME_FROM_VA_LIST(e,f,va) do { \ const cl_object __frame = (f); \ + cl_object *base; \ cl_index i, __nargs = va[0].narg; \ ecl_stack_frame_open((e), __frame, __nargs); \ + base = ECL_STACK_FRAME_PTR(__frame); \ for (i = 0; i < __nargs; i++) { \ - __frame->frame.base[i] = ecl_va_arg(va); \ + base[i] = ecl_va_arg(va); \ } \ } while (0) @@ -356,7 +358,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, const cl_env_ptr env = ecl_process_env(); \ if (narg <= ECL_C_ARGUMENTS_LIMIT) { \ ecl_stack_frame_open(env, frame, narg); \ - cl_object *p = frame->frame.base; \ + cl_object *p = ECL_STACK_FRAME_PTR(frame); \ va_list args; \ va_start(args, lastarg); \ while (narg--) { \ @@ -365,11 +367,13 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form, } \ va_end(args); \ } else { \ + cl_index bindex = ECL_STACK_INDEX(env) - narg; \ frame->frame.t = t_frame; \ - frame->frame.env = env; \ + frame->frame.opened = 0; \ + frame->frame.base = bindex; \ frame->frame.size = narg; \ - frame->frame.base = env->stack_top - narg; \ - frame->frame.stack = 0; \ + frame->frame.sp = bindex; \ + frame->frame.env = env; \ } #define ECL_STACK_FRAME_VARARGS_END(frame) ecl_stack_frame_close(frame) diff --git a/src/h/object.h b/src/h/object.h index ef1d6094c..e0ee2fb34 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -925,11 +925,10 @@ struct ecl_foreign { /* user defined datatype */ }; struct ecl_stack_frame { - _ECL_HDR; - cl_object *stack; /* Is this relative to the lisp stack? */ - cl_object *base; /* Start of frame */ - cl_object *sp; /* Stack pointer */ + _ECL_HDR1(opened); + cl_index base; /* Start of the stack frame */ cl_index size; /* Number of arguments */ + cl_index sp; /* Stack pointer */ struct cl_env_struct *env; }; diff --git a/src/h/stacks.h b/src/h/stacks.h index e12ea70d3..1c38c41c3 100755 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -417,16 +417,21 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(cl_env_ptr); } \ __env->stack_top = __new_top + __aux; } while (0) -#define ECL_STACK_FRAME_COPY(dest,orig) do { \ - cl_object __dest = (dest); \ - cl_object __orig = (orig); \ - cl_index __size = __orig->frame.size; \ - ecl_stack_frame_open(__orig->frame.env, __dest, __size); \ - memcpy(__dest->frame.base, __orig->frame.base, __size * sizeof(cl_object)); \ - } while (0); +#define ECL_STACK_FRAME_REF(f,ndx) ((f)->frame.env->stack[(f)->frame.base+(ndx)]) +#define ECL_STACK_FRAME_SET(f,ndx,o) do { ECL_STACK_FRAME_REF(f,ndx) = (o); } while(0) -#define ECL_STACK_FRAME_SET(f,ndx,o) do { (f)->frame.base[(ndx)] = (o); } while(0) -#define ECL_STACK_FRAME_REF(f,ndx) ((f)->frame.base[(ndx)]) +#define ECL_STACK_FRAME_PTR(f) ((f)->frame.env->stack+(f)->frame.base) +#define ECL_STACK_FRAME_TOP(f) ((f)->frame.env->stack+(f)->frame.sp) + +#define ECL_STACK_FRAME_COPY(dest,orig) do { \ + cl_object __dst = (dest); \ + cl_object __src = (orig); \ + cl_index __size = __src->frame.size; \ + ecl_stack_frame_open(__src->frame.env, __dst, __size); \ + memcpy(ECL_STACK_FRAME_PTR(__dst), \ + ECL_STACK_FRAME_PTR(__src), \ + __size * sizeof(cl_object)); \ + } while (0); /********************************* * HIGH LEVEL CONTROL STRUCTURES *