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

More compact format for bytecodes OP_FLET/LABELS

Browse source
This commit is contained in:
jjgarcia 2008-06-19 15:03:56 +00:00
parent 590129c767
commit b2d1a996b3
3 changed files with 31 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/c/compiler.d
View file

@ -1082,12 +1082,9 @@ c_eval_when(cl_object args, int flags) {
The OP_FLET/OP_FLABELS operators change the lexical environment
to add a few local functions.
[OP_FLET/OP_FLABELS + nfun]
fun1
[OP_FLET/OP_FLABELS + nfun + fun1]
...
fun2
...
OP_UNBIND n
OP_UNBIND nfun
labelz:
*/
static cl_index
@ -1106,7 +1103,11 @@ static int
c_labels_flet(int op, cl_object args, int flags) {
cl_object l, def_list = pop(&args);
struct cl_compiler_env *old_c_env, new_c_env;
cl_index nfun;
cl_index nfun, first = 0;
if (ecl_length(def_list) == 0) {
return c_locally(args, flags);
}
old_c_env = ENV;
new_c_env = *ENV;
@ -1129,7 +1130,12 @@ c_labels_flet(int op, cl_object args, int flags) {
for (l = def_list; !ecl_endp(l); ) {
cl_object definition = pop(&l);
cl_object name = pop(&definition);
asm_c(ecl_make_lambda(name, definition));
cl_object lambda = ecl_make_lambda(name, definition);
cl_index c = c_register_constant(lambda);
if (first == 0) {
asm_arg(c);
first = 1;
}
}
/* If compiling a FLET form, add the function names to the lexical

18
src/c/disassembler.d
View file

@ -114,10 +114,7 @@ NO_ARGS:
/* -------------------- DISASSEMBLER CORE -------------------- */
/* OP_FLET nfun{arg}
fun1{object}
...
funn{object}
/* OP_FLET nfun{arg}, fun1{object}
...
Executes the enclosed code in a lexical enviroment extended with
@ -126,18 +123,17 @@ NO_ARGS:
static cl_opcode *
disassemble_flet(cl_object bytecodes, cl_opcode *vector) {
cl_index nfun = GET_OPARG(vector);
cl_index first = GET_OPARG(vector);
cl_object *data = bytecodes->bytecodes.data + first;
print_noarg("FLET");
while (nfun--) {
cl_object fun = GET_DATA(vector, bytecodes);
cl_object fun = *(data++);
print_arg("\n\tFLET\t", fun->bytecodes.name);
}
return vector;
}
/* OP_LABELS nfun{arg}
fun1{object}
...
funn{object}
/* OP_LABELS nfun{arg}, fun1{object}
...
Executes the enclosed code in a lexical enviroment extended with
@ -146,9 +142,11 @@ disassemble_flet(cl_object bytecodes, cl_opcode *vector) {
static cl_opcode *
disassemble_labels(cl_object bytecodes, cl_opcode *vector) {
cl_index nfun = GET_OPARG(vector);
cl_index first = GET_OPARG(vector);
cl_object *data = bytecodes->bytecodes.data + first;
print_noarg("LABELS");
while (nfun--) {
cl_object fun = GET_DATA(vector, bytecodes);
cl_object fun = *(data++);
print_arg("\n\tLABELS\t", fun->bytecodes.name);
}
return vector;

19
src/c/interpreter.d
View file

@ -678,25 +678,24 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
ihs_pop();
return VALUES(0);
}
/* OP_FLET nfun{arg}
fun1{object}
/* OP_FLET nfun{arg}, fun1{object}
...
funn{object}
...
OP_UNBIND n
OP_UNBIND nfun
Executes the enclosed code in a lexical enviroment extended with
the functions "fun1" ... "funn".
the functions "fun1" ... "funn". Note that we only record the
index of the first function: the others are after this one.
*/
CASE(OP_FLET); {
cl_index nfun = GET_OPARG(vector);
cl_index first = GET_OPARG(vector);
cl_object *fun = bytecodes->bytecodes.data + first;
/* Copy the environment so that functions get it without references
to themselves, and then add new closures to the environment. */
cl_object old_lex = lex_env;
cl_object new_lex = old_lex;
while (nfun--) {
cl_object fun = GET_DATA(vector, bytecodes);
cl_object f = close_around(fun, old_lex);
cl_object f = close_around(*(fun++), old_lex);
new_lex = bind_function(new_lex, f->bytecodes.name, f);
}
lex_env = new_lex;
@ -714,10 +713,12 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc)
*/
CASE(OP_LABELS); {
cl_index i, nfun = GET_OPARG(vector);
cl_index first = GET_OPARG(vector);
cl_object *fun = bytecodes->bytecodes.data + first;
cl_object l, new_lex;
/* Build up a new environment with all functions */
for (new_lex = lex_env, i = nfun; i; i--) {
cl_object f = GET_DATA(vector, bytecodes);
cl_object f = *(fun++);
new_lex = bind_function(new_lex, f->bytecodes.name, f);
}
/* Update the closures so that all functions can call each other */