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

stack frames: dereference directly to env->stack

Browse source 
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.
This commit is contained in:
Daniel Kochmański 2025-05-08 15:45:00 +02:00
parent 293f93b425
commit 2f9ce70e8f
9 changed files with 68 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/alloc_2.d
View file

@ -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

10
src/c/clos/gfun.d
View file

@ -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;

4
src/c/compiler.d
View file

@ -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;

6
src/c/eval.d
View file

@ -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)) {

32
src/c/interpreter.d
View file

@ -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; idx<nfun; idx++) {

21
src/c/stacks.d
View file

@ -218,16 +218,18 @@ cl_object
ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size)
{
cl_object *base = env->stack_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);
}
}

14
src/h/internal.h
View file

@ -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)

7
src/h/object.h
View file

@ -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;
};

23
src/h/stacks.h
View file

@ -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 *