mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-09 22:50:34 -07:00
ecl_interpreter: abstract away all lcl accessors
We are going to change the representation of the local environment, but first we make identify accessors and put them behind macros. While doing so the OP_LABELS has been changed to look similar to OP_FLET. Among other things we cons separately functions into fun_env, but this inefficiency will be removed later when we address local entries from the frame.base.
This commit is contained in:
Daniel Kochmański
parent
a44a74a3f4
commit
c2d1a0c2d2
1 changed files with 59 additions and 39 deletions
|
|
@ -121,9 +121,34 @@ VEclose_around_arg_type()
|
|||
* sym_macro = ( si::symbol-macro macro_function[bytecodes] . macro_name )
|
||||
*/
|
||||
|
||||
#define bind_var(env, var, val) CONS(CONS(var, val), (env))
|
||||
#define bind_function(env, fun) CONS(fun, (env))
|
||||
#define bind_frame(env, id, name) CONS(CONS(id, name), (env))
|
||||
#define bind_lcl(env, entry) push_lcl(&env, entry)
|
||||
#define tack_lcl(env, entries) foot_lcl(&env, entries)
|
||||
|
||||
#define bind_var(env, var, val) bind_lcl(env, CONS(var, val))
|
||||
#define bind_function(env, fun) bind_lcl(env, fun)
|
||||
#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) (stack)
|
||||
#define unwind_lcl(stack, where) (stack = where)
|
||||
|
||||
static void
|
||||
push_lcl(cl_object *stack, cl_object new)
|
||||
{
|
||||
*stack = ecl_cons(new, *stack);
|
||||
}
|
||||
|
||||
static void
|
||||
foot_lcl(cl_object *stack, cl_object list)
|
||||
{
|
||||
*stack = ecl_append(list, *stack);
|
||||
}
|
||||
|
||||
static void
|
||||
drop_lcl(cl_object *stack, cl_fixnum n)
|
||||
{
|
||||
while (n--) *stack = ECL_CONS_CDR(*stack);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
ecl_lcl_env_get_record(cl_object env, int s)
|
||||
|
|
@ -697,10 +722,10 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
for(idx = 0; idx<nfun; idx++) {
|
||||
GET_DATA(fun, vector, data);
|
||||
fun = ecl_close_around(fun, lcl_env, lex_env);
|
||||
fun_env = bind_function(fun_env, fun);
|
||||
fun_env = CONS(fun, fun_env);
|
||||
}
|
||||
/* Update the environment with new functions. */
|
||||
lcl_env = ecl_append(fun_env, lcl_env);
|
||||
tack_lcl(lcl_env, fun_env);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
/* OP_LABELS nfun{arg}
|
||||
|
|
@ -714,26 +739,22 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
the functions "fun1" ... "funn".
|
||||
*/
|
||||
CASE(OP_LABELS); {
|
||||
cl_index nfun;
|
||||
cl_index idx, nfun;
|
||||
cl_object fun_env=ECL_NIL, fun;
|
||||
GET_OPARG(nfun, vector);
|
||||
/* Build up a new environment with all functions */
|
||||
{
|
||||
cl_index i = nfun;
|
||||
do {
|
||||
cl_object f;
|
||||
GET_DATA(f, vector, data);
|
||||
f = close_around_self(f);
|
||||
lcl_env = bind_function(lcl_env, f);
|
||||
} while (--i);
|
||||
/* Create closures. */
|
||||
for(idx = 0; idx<nfun; idx++) {
|
||||
GET_DATA(fun, vector, data);
|
||||
fun = close_around_self(fun);
|
||||
fun_env = CONS(fun, fun_env);
|
||||
}
|
||||
/* Update the environment with new functions. */
|
||||
tack_lcl(lcl_env, fun_env);
|
||||
/* Update the closures so that all functions can call each other */
|
||||
{
|
||||
cl_object l = lcl_env;
|
||||
do {
|
||||
close_around_self_fixup(ECL_CONS_CAR(l), lcl_env, lex_env);
|
||||
l = ECL_CONS_CDR(l);
|
||||
} while (--nfun);
|
||||
}
|
||||
loop_for_on_unsafe(fun_env) {
|
||||
fun = ECL_CONS_CAR(fun_env);
|
||||
close_around_self_fixup(fun, lcl_env, lex_env);
|
||||
} end_loop_for_on_unsafe(fun_env);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
/* OP_LFUNCTION index{fixnum} ; local
|
||||
|
|
@ -902,8 +923,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_UNBIND); {
|
||||
cl_oparg n;
|
||||
GET_OPARG(n, vector);
|
||||
while (n--)
|
||||
lcl_env = ECL_CONS_CDR(lcl_env);
|
||||
unbind_lcl(lcl_env, n);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
/* OP_UNBINDS n{arg}
|
||||
|
|
@ -928,13 +948,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_BIND); {
|
||||
cl_object var_name;
|
||||
GET_DATA(var_name, vector, data);
|
||||
lcl_env = bind_var(lcl_env, var_name, reg0);
|
||||
bind_var(lcl_env, var_name, reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_PBIND); {
|
||||
cl_object var_name;
|
||||
GET_DATA(var_name, vector, data);
|
||||
lcl_env = bind_var(lcl_env, var_name, ECL_STACK_POP_UNSAFE(the_env));
|
||||
bind_var(lcl_env, var_name, ECL_STACK_POP_UNSAFE(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_VBIND); {
|
||||
|
|
@ -942,8 +962,8 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
cl_object var_name;
|
||||
GET_OPARG(n, vector);
|
||||
GET_DATA(var_name, vector, data);
|
||||
lcl_env = bind_var(lcl_env, var_name,
|
||||
(n < the_env->nvalues) ? the_env->values[n] : ECL_NIL);
|
||||
bind_var(lcl_env, var_name,
|
||||
(n < the_env->nvalues) ? the_env->values[n] : ECL_NIL);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_BINDS); {
|
||||
|
|
@ -1070,24 +1090,24 @@ 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++);
|
||||
lcl_env = bind_frame(lcl_env, reg1, reg0);
|
||||
bind_frame(lcl_env, reg1, reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_DO); {
|
||||
reg0 = ECL_NIL;
|
||||
reg1 = ecl_make_fixnum(the_env->frame_id++);
|
||||
lcl_env = bind_frame(lcl_env, reg1, reg0);
|
||||
bind_frame(lcl_env, reg1, reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_CATCH); {
|
||||
reg1 = reg0;
|
||||
lcl_env = bind_frame(lcl_env, reg1, reg0);
|
||||
bind_frame(lcl_env, reg1, reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_FRAME); {
|
||||
cl_opcode *exit;
|
||||
GET_LABEL(exit, vector);
|
||||
ECL_STACK_PUSH(the_env, lcl_env);
|
||||
ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
|
||||
ECL_STACK_PUSH(the_env, (cl_object)exit);
|
||||
ecl_frs_push(the_env,reg1);
|
||||
if (__ecl_frs_push_result == 0) {
|
||||
|
|
@ -1095,7 +1115,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
} else {
|
||||
reg0 = the_env->values[0];
|
||||
vector = (cl_opcode *)ECL_STACK_REF(the_env,-1); /* FIXME! */
|
||||
lcl_env = ECL_STACK_REF(the_env,-2);
|
||||
unwind_lcl(lcl_env, ECL_STACK_REF(the_env, -2));
|
||||
goto DO_EXIT_FRAME;
|
||||
}
|
||||
}
|
||||
|
|
@ -1115,7 +1135,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_TAGBODY); {
|
||||
int n;
|
||||
GET_OPARG(n, vector);
|
||||
ECL_STACK_PUSH(the_env, lcl_env);
|
||||
ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
|
||||
ECL_STACK_PUSH(the_env, (cl_object)vector); /* FIXME! */
|
||||
vector += n * OPARG_SIZE;
|
||||
ecl_frs_push(the_env,reg1);
|
||||
|
|
@ -1124,7 +1144,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
ranges from 0 to ntags-1, depending on the tag. These numbers are
|
||||
indices into the jump table and are computed at compile time. */
|
||||
cl_opcode *table = (cl_opcode *)ECL_STACK_REF(the_env,-1);
|
||||
lcl_env = ECL_STACK_REF(the_env,-2);
|
||||
unwind_lcl(lcl_env, ECL_STACK_REF(the_env,-2));
|
||||
table = table + ecl_fixnum(the_env->values[0]) * OPARG_SIZE;
|
||||
vector = table + *(cl_oparg *)table;
|
||||
}
|
||||
|
|
@ -1137,7 +1157,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
DO_EXIT_FRAME:
|
||||
ecl_frs_pop(the_env);
|
||||
ECL_STACK_POP_N_UNSAFE(the_env, 2);
|
||||
lcl_env = ECL_CONS_CDR(lcl_env);
|
||||
unbind_lcl(lcl_env, 1);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_NIL); {
|
||||
|
|
@ -1241,13 +1261,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PROTECT); {
|
||||
cl_opcode *exit;
|
||||
GET_LABEL(exit, vector);
|
||||
ECL_STACK_PUSH(the_env, lcl_env);
|
||||
ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
|
||||
ECL_STACK_PUSH(the_env, (cl_object)exit);
|
||||
ecl_frs_push(the_env,ECL_PROTECT_TAG);
|
||||
if (__ecl_frs_push_result != 0) {
|
||||
ecl_frs_pop(the_env);
|
||||
vector = (cl_opcode *)ECL_STACK_POP_UNSAFE(the_env);
|
||||
lcl_env = 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));
|
||||
goto PUSH_VALUES;
|
||||
|
|
@ -1258,7 +1278,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
ecl_bds_unwind(the_env, the_env->frs_top->frs_bds_top_index);
|
||||
ecl_frs_pop(the_env);
|
||||
(void)ECL_STACK_POP_UNSAFE(the_env);
|
||||
lcl_env = ECL_STACK_POP_UNSAFE(the_env);
|
||||
unwind_lcl(lcl_env, ECL_STACK_POP_UNSAFE(the_env));
|
||||
ECL_STACK_PUSH(the_env, ecl_make_fixnum(1));
|
||||
goto PUSH_VALUES;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue