diff --git a/src/c/compiler.d b/src/c/compiler.d index fc70711b7..24a9ec4e2 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -455,28 +455,37 @@ guess_environment(cl_object interpreter_env) } static void -c_new_env(struct cl_compiler_env *new_c_env, cl_object env) +c_new_env(cl_compiler_env_ptr new, cl_object env, cl_compiler_env_ptr old) { - ENV = new_c_env; - ENV->stepping = 0; - ENV->coalesce = TRUE; - ENV->macros = Cnil; - ENV->lexical_level = 0; - ENV->constants = Cnil; - if (Null(env)) { - ENV->macros = Cnil; - ENV->variables = Cnil; + ENV = new; + new->stepping = 0; + new->coalesce = TRUE; + new->lexical_level = 0; + new->constants = Cnil; + new->env_depth = 0; + new->env_size = 0; + if (old) { + if (!Null(env)) + ecl_internal_error("c_new_env with both ENV and OLD"); + new->variables = old->variables; + new->macros = old->macros; + new->lexical_level = old->lexical_level; + new->constants = old->constants; + new->lex_env = old->lex_env; + new->env_depth = old->env_depth + 1; + new->coalesce = old->coalesce; + new->stepping = old->stepping; } else { - ENV->variables = CAR(env); - ENV->macros = CDR(env); - for (env = ENV->variables; !Null(env); env = CDR(env)) { + new->variables = CAR(env); + new->macros = CDR(env); + for (env = new->variables; !Null(env); env = CDR(env)) { cl_object record = CAR(env); if (ATOM(record)) continue; if (SYMBOLP(CAR(record)) && CADR(record) != @'si::symbol-macro') { continue; } else { - ENV->lexical_level = 1; + new->lexical_level = 1; break; } } @@ -615,13 +624,13 @@ c_bind(cl_object var, cl_object specials) } static void -c_undo_bindings(cl_object old_env) +c_undo_bindings(cl_object old_vars) { cl_object env; cl_index num_lexical = 0; cl_index num_special = 0; - for (env = ENV->variables; env != old_env && !Null(env); env = ECL_CONS_CDR(env)) + for (env = ENV->variables; env != old_vars && !Null(env); env = ECL_CONS_CDR(env)) { cl_object record = ECL_CONS_CAR(env); cl_object name = CAR(record); @@ -640,9 +649,9 @@ c_undo_bindings(cl_object old_env) } } } + ENV->variables = env; if (num_lexical) asm_op2(OP_UNBIND, num_lexical); if (num_special) asm_op2(OP_UNBINDS, num_special); - ENV->variables = old_env; } static void @@ -1128,17 +1137,14 @@ c_register_functions(cl_object l) 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_object old_vars = ENV->variables; + cl_object old_funs = ENV->macros; cl_index nfun, first = 0; if (ecl_length(def_list) == 0) { return c_locally(args, flags); } - old_c_env = ENV; - new_c_env = *ENV; - ENV = &new_c_env; - /* Remove declarations */ args = c_process_declarations(args); @@ -1174,9 +1180,8 @@ c_labels_flet(int op, cl_object args, int flags) { flags = compile_body(args, flags); /* Restore and return */ - c_undo_bindings(old_c_env->variables); - old_c_env->constants = ENV->constants; - ENV = old_c_env; + c_undo_bindings(old_vars); + ENV->macros = old_funs; return flags; } @@ -2518,8 +2523,7 @@ ecl_make_lambda(cl_object name, cl_object lambda) { @list*(3, @'ext::lambda-block', name, lambda)); old_c_env = ENV; - new_c_env = *ENV; - ENV = &new_c_env; + c_new_env(&new_c_env, Cnil, old_c_env); ENV->lexical_level++; ENV->coalesce = 0; @@ -2657,10 +2661,10 @@ cl_object si_make_lambda(cl_object name, cl_object rest) { cl_object lambda; - struct cl_compiler_env *old_c_env, new_c_env; + volatile cl_compiler_env_ptr old_c_env = ENV; + struct cl_compiler_env new_c_env; - old_c_env = ENV; - c_new_env(&new_c_env, Cnil); + c_new_env(&new_c_env, Cnil, 0); CL_UNWIND_PROTECT_BEGIN { lambda = ecl_make_lambda(name,rest); } CL_UNWIND_PROTECT_EXIT { @@ -2670,7 +2674,7 @@ si_make_lambda(cl_object name, cl_object rest) } @(defun si::eval-with-env (form &optional (env Cnil) (stepping Cnil) (compiler_env_p Cnil)) - struct cl_compiler_env *old_c_env = ENV; + volatile cl_compiler_env_ptr old_c_env = ENV; struct cl_compiler_env new_c_env; volatile cl_index handle; struct ihs_frame ihs; @@ -2679,7 +2683,6 @@ si_make_lambda(cl_object name, cl_object rest) /* * Compile to bytecodes. */ - ENV = &new_c_env; if (compiler_env_p == Cnil) { interpreter_env = env; compiler_env = Cnil; @@ -2687,7 +2690,7 @@ si_make_lambda(cl_object name, cl_object rest) interpreter_env = Cnil; compiler_env = env; } - c_new_env(&new_c_env, compiler_env); + c_new_env(&new_c_env, compiler_env, 0); guess_environment(interpreter_env); ENV->lex_env = env; ENV->stepping = stepping != Cnil; diff --git a/src/c/disassembler.d b/src/c/disassembler.d index 5f41adb53..f53e2a2ca 100644 --- a/src/c/disassembler.d +++ b/src/c/disassembler.d @@ -370,6 +370,11 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { */ case OP_CATCH: string = "CATCH\t"; goto JMP; + /* OP_ENTRY + Marks the entry of a lambda form + */ + case OP_ENTRY: string = "ENTRY"; + goto NOARG; /* OP_EXIT Marks the end of a high level construct */ diff --git a/src/h/internal.h b/src/h/internal.h index c513fb7b2..d81cd09ae 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -55,15 +55,19 @@ extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size); /* compiler.d */ struct cl_compiler_env { - cl_object variables; - cl_object macros; - cl_fixnum lexical_level; - cl_object constants; - cl_object lex_env; + cl_object variables; /* Variables, tags, functions, etc: the env. */ + cl_object macros; /* Macros and function bindings */ + cl_fixnum lexical_level; /* =0 if toplevel form */ + cl_object constants; /* Constants for this form */ + cl_object lex_env; /* Lexical env. for eval-when */ + cl_index env_depth; + cl_index env_size; bool coalesce; bool stepping; }; +typedef struct cl_compiler_env *cl_compiler_env_ptr; + /* interpreter.d */ #define cl_stack_ref(n) cl_env.stack[n]