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 *