From 702dafcf9421dba5cec062ee2735445caa23bfc8 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 27 Feb 2009 23:40:39 +0100 Subject: [PATCH] Use bytecodes to undo the special bindings before exiting an interpreted function, not by keeping a copy of the bds_top pointer. --- src/c/compiler.d | 30 +++++++++++++++++------------- src/c/interpreter.d | 4 ---- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index 45a86cbe4..cd125107e 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -697,7 +697,7 @@ c_bind(cl_env_ptr env, cl_object var, cl_object specials) } static void -c_undo_bindings(cl_env_ptr the_env, cl_object old_vars) +c_undo_bindings(cl_env_ptr the_env, cl_object old_vars, int only_specials) { cl_object env; cl_index num_lexical = 0; @@ -712,7 +712,7 @@ c_undo_bindings(cl_env_ptr the_env, cl_object old_vars) if (name == @':block' || name == @':tag') { (void)0; } else if (name == @':function' || Null(special)) { - num_lexical++; + only_specials || num_lexical++; } else if (name == @':declare') { /* Ignored */ } else if (special != @'si::symbol-macro') { @@ -850,7 +850,7 @@ c_block(cl_env_ptr env, cl_object body, int old_flags) { set_pc(env, pc); return compile_body(env, body, old_flags); } else { - c_undo_bindings(env, old_env.variables); + c_undo_bindings(env, old_env.variables, 0); asm_op(env, OP_EXIT_FRAME); asm_complete(env, 0, labelz); return flags; @@ -1034,7 +1034,7 @@ c_catch(cl_env_ptr env, cl_object args, int flags) { /* Compile body of CATCH */ compile_body(env, args, FLAG_VALUES); - c_undo_bindings(env, old_env); + c_undo_bindings(env, old_env, 0); asm_op(env, OP_EXIT_FRAME); asm_complete(env, 0, labelz); @@ -1253,7 +1253,7 @@ c_labels_flet(cl_env_ptr env, int op, cl_object args, int flags) { flags = c_locally(env, args, flags); /* Restore and return */ - c_undo_bindings(env, old_vars); + c_undo_bindings(env, old_vars, 0); env->c_env->macros = old_funs; return flags; @@ -1436,7 +1436,7 @@ c_let_leta(cl_env_ptr env, int op, cl_object args, int flags) { flags = compile_body(env, body, flags); - c_undo_bindings(env, old_variables); + c_undo_bindings(env, old_variables, 0); return flags; } @@ -1469,7 +1469,7 @@ c_locally(cl_env_ptr env, cl_object args, int flags) { /* ...and then process body */ flags = compile_body(env, args, flags); - c_undo_bindings(env, old_env); + c_undo_bindings(env, old_env, 0); return flags; } @@ -1532,7 +1532,7 @@ c_multiple_value_bind(cl_env_ptr env, cl_object args, int flags) if (n == 0) { c_declare_specials(env, specials); flags = compile_body(env, body, flags); - c_undo_bindings(env, old_env); + c_undo_bindings(env, old_env, 0); } else { cl_object old_variables = env->c_env->variables; for (vars=cl_reverse(vars); n--; ) { @@ -1543,7 +1543,7 @@ c_multiple_value_bind(cl_env_ptr env, cl_object args, int flags) } c_declare_specials(env, specials); flags = compile_body(env, body, flags); - c_undo_bindings(env, old_variables); + c_undo_bindings(env, old_variables, 0); } return flags; } @@ -1632,7 +1632,7 @@ c_multiple_value_setq(cl_env_ptr env, cl_object orig_args, int flags) { } } - c_undo_bindings(env, old_variables); + c_undo_bindings(env, old_variables, 0); return FLAG_REG0; } @@ -1870,7 +1870,7 @@ declared special and appear in a symbol-macrolet.", 1, name); } c_declare_specials(env, specials); flags = compile_body(env, body, flags); - c_undo_bindings(env, old_variables); + c_undo_bindings(env, old_variables, 0); return flags; } @@ -1916,7 +1916,7 @@ c_tagbody(cl_env_ptr env, cl_object args, int flags) } } asm_op(env, OP_EXIT_TAGBODY); - c_undo_bindings(env, old_env); + c_undo_bindings(env, old_env, 0); return FLAG_REG0; } @@ -2621,7 +2621,7 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) { * to be used. We use this to mark the boundary of a function * environment and when code-walking */ c_register_var(env, cl_make_symbol(make_constant_base_string("FUNCTION")), - TRUE, TRUE); + TRUE, FALSE); new_c_env.constants = Cnil; new_c_env.coalesce = TRUE; @@ -2673,12 +2673,16 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) { c_bind(env, var, specials); } c_declare_specials(env, specials); + if (!Null(name)) { compile_form(env, @list*(3, @'block', si_function_block_name(name), body), FLAG_VALUES); } else { compile_body(env, body, FLAG_VALUES); } + + /* Only undo special bindings */ + c_undo_bindings(env, old_c_env->variables, 1); asm_op(env, OP_EXIT); output = asm_end(env, handle); diff --git a/src/c/interpreter.d b/src/c/interpreter.d index d2d36bf5d..94be24fd1 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -292,7 +292,6 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes) { ECL_OFFSET_TABLE; const cl_env_ptr the_env = frame->frame.env; - volatile cl_index old_bds_top_index = the_env->bds_top - the_env->bds_org; volatile cl_index frame_index = 0; cl_opcode *vector = (cl_opcode*)bytecodes->bytecodes.code; cl_object *data = bytecodes->bytecodes.data; @@ -309,8 +308,6 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes) frame_aux.stack = frame_aux.base = 0; frame_aux.size = 0; frame_aux.env = the_env; - reg0 = Cnil; - the_env->nvalues = 0; BEGIN: BEGIN_SWITCH { CASE(OP_NOP); { @@ -674,7 +671,6 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes) */ CASE(OP_EXIT); { ecl_ihs_pop(the_env); - ecl_bds_unwind(the_env, old_bds_top_index); return reg0; } /* OP_FLET nfun{arg}, fun1{object}