diff --git a/src/c/eval.d b/src/c/eval.d index 9b2751139..013a7f91d 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_top - narg; + return ecl_process_env()->stack_frame->frame.base + narg; } /* Calling conventions: @@ -37,6 +37,8 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x) cl_object *sp = frame->frame.base; cl_index narg = frame->frame.size; cl_object fun = x; + cl_object ret; + frame->frame.env->stack_frame = frame; AGAIN: frame->frame.env->function = fun; if (ecl_unlikely(fun == OBJNULL || fun == ECL_NIL)) @@ -45,37 +47,47 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x) case t_cfunfixed: if (ecl_unlikely(narg != (cl_index)fun->cfun.narg)) FEwrong_num_arguments(fun); - return APPLY_fixed(narg, fun->cfunfixed.entry_fixed, sp); + ret = APPLY_fixed(narg, fun->cfunfixed.entry_fixed, sp); + break; case t_cfun: - return APPLY(narg, fun->cfun.entry, sp); + ret = APPLY(narg, fun->cfun.entry, sp); + break; case t_cclosure: - return APPLY(narg, fun->cclosure.entry, sp); + ret = APPLY(narg, fun->cclosure.entry, sp); + break; case t_instance: switch (fun->instance.isgf) { case ECL_STANDARD_DISPATCH: case ECL_RESTRICTED_DISPATCH: - return _ecl_standard_dispatch(frame, fun); + ret = _ecl_standard_dispatch(frame, fun); + break; case ECL_USER_DISPATCH: fun = fun->instance.slots[fun->instance.length - 1]; goto AGAIN; case ECL_READER_DISPATCH: case ECL_WRITER_DISPATCH: - return APPLY(narg, fun->instance.entry, sp); + ret = APPLY(narg, fun->instance.entry, sp); + break; default: FEinvalid_function(fun); } + break; case t_symbol: if (ecl_unlikely(fun->symbol.stype & ecl_stp_macro)) FEundefined_function(x); fun = ECL_SYM_FUN(fun); goto AGAIN; case t_bytecodes: - return ecl_interpret(frame, ECL_NIL, fun); + ret = ecl_interpret(frame, ECL_NIL, fun); + break; case t_bclosure: - return ecl_interpret(frame, fun->bclosure.lex, fun->bclosure.code); + ret = ecl_interpret(frame, fun->bclosure.lex, fun->bclosure.code); + break; default: FEinvalid_function(x); } + frame->frame.env->stack_frame = NULL; /* for gc's sake */ + return ret; } cl_objectfn diff --git a/src/c/interpreter.d b/src/c/interpreter.d index cf4088a6d..c2932518c 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -510,6 +510,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes) cl_object frame = (cl_object)&frame_aux; frame_aux.size = narg; frame_aux.base = the_env->stack_top - narg; + the_env->stack_frame = frame; SETUP_ENV(the_env); AGAIN: if (ecl_unlikely(reg0 == OBJNULL || reg0 == ECL_NIL)) @@ -561,11 +562,12 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes) FEinvalid_function(reg0); } ECL_STACK_POP_N_UNSAFE(the_env, narg); + the_env->stack_frame = NULL; /* for gc's sake */ THREAD_NEXT; } /* OP_POP - Pops a singe value pushed by a OP_PUSH* operator. + Pops a single value pushed by a OP_PUSH* operator. */ CASE(OP_POP); { reg0 = ECL_STACK_POP_UNSAFE(the_env); diff --git a/src/c/unixint.d b/src/c/unixint.d index 8b0617f5c..d6a5af1d4 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -384,6 +384,7 @@ handle_all_queued_interrupt_safe(cl_env_ptr env) cl_index nvalues = env->nvalues; cl_object values[ECL_MULTIPLE_VALUES_LIMIT]; memcpy(values, env->values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object)); + cl_object stack_frame = env->stack_frame; cl_object big_register[3]; memcpy(big_register, env->big_register, 3*sizeof(cl_object)); cl_object packages_to_be_created = env->packages_to_be_created; @@ -409,6 +410,7 @@ handle_all_queued_interrupt_safe(cl_env_ptr env) env->packages_to_be_created_p = packages_to_be_created_p; env->packages_to_be_created = packages_to_be_created; memcpy(env->big_register, big_register, 3*sizeof(cl_object)); + env->stack_frame = stack_frame; memcpy(env->values, values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object)); env->nvalues = nvalues; env->function = fun; diff --git a/src/h/external.h b/src/h/external.h index c671a2e11..c944f063d 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -26,6 +26,9 @@ struct cl_env_struct { /* Environment for calling closures, CLOS generic functions, etc */ cl_object function; + /* Current stack frame */ + cl_object stack_frame; + /* The four stacks in ECL. */ /* diff --git a/src/h/stacks.h b/src/h/stacks.h index fd10ebae9..4c26ca464 100755 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -340,7 +340,7 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr); #define ecl_va_start(a,p,n,k) { \ a[0].narg = (n)-(k); \ va_start(a[0].args,p); \ - a[0].sp = ((n) <= ECL_C_ARGUMENTS_LIMIT)? 0 : _ecl_va_sp(a[0].narg); } + a[0].sp = ((n) <= ECL_C_ARGUMENTS_LIMIT)? 0 : _ecl_va_sp(k); } #define ecl_va_arg(a) \ (a[0].narg--,(a[0].sp? *(a[0].sp++) : va_arg(a[0].args,cl_object))) #define ecl_va_copy(dest,orig) { \