diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 7d5305e4b..62bba5b91 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -647,6 +647,7 @@ void init_type_info (void) to_bitmap(&o, &(o.bytecodes.code)) | to_bitmap(&o, &(o.bytecodes.data)) | to_bitmap(&o, &(o.bytecodes.flex)) | + to_bitmap(&o, &(o.bytecodes.nlcl)) | to_bitmap(&o, &(o.bytecodes.file)) | to_bitmap(&o, &(o.bytecodes.file_position)); type_info[t_bclosure].descriptor = diff --git a/src/c/compiler.d b/src/c/compiler.d index a0143630d..eeef04798 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -164,6 +164,13 @@ push(cl_object v, cl_object *l) { return *l; } +static void +c_env_sync_width(cl_compiler_ptr c_env) +{ + if(c_env->env_size > c_env->env_width) + c_env->env_width = c_env->env_size; +} + /* ------------------------------ ASSEMBLER ------------------------------ */ static cl_object @@ -190,6 +197,8 @@ asm_end(cl_env_ptr env, cl_index beginning, cl_object definition) { bytecodes->bytecodes.code = ecl_alloc_atomic(code_size * sizeof(cl_opcode)); bytecodes->bytecodes.data = c_env->constants; bytecodes->bytecodes.flex = ECL_NIL; + c_env_sync_width(c_env); + bytecodes->bytecodes.nlcl = ecl_make_fixnum(c_env->env_width); for (i = 0, code = (cl_opcode *)bytecodes->bytecodes.code; i < code_size; i++) { code[i] = (cl_opcode)(cl_fixnum)(env->stack[beginning+i]); } @@ -618,6 +627,7 @@ c_new_env(cl_env_ptr the_env, cl_compiler_env_ptr new, cl_object env, new->mode = FLAG_EXECUTE; new->function_boundary_crossed = 0; } + new->env_width = 0; new->env_size = 0; } @@ -1088,6 +1098,8 @@ c_undo_bindings(cl_env_ptr the_env, cl_object old_vars, int only_specials) } } c_env->variables = env; + c_env_sync_width(c_env); + c_env->env_size -= num_lexical; if (num_lexical) asm_op2(the_env, OP_UNBIND, num_lexical); if (num_special) asm_op2(the_env, OP_UNBINDS, num_special); } @@ -2748,6 +2760,7 @@ eval_nontrivial_form(cl_env_ptr env, cl_object form) { ECL_NIL); new_c_env.parent_env = NULL; new_c_env.env_depth = 0; + new_c_env.env_width = 0; new_c_env.env_size = 0; env->c_env = &new_c_env; handle = asm_begin(env); @@ -3608,6 +3621,10 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) { output = asm_end(env, handle, lambda); output->bytecodes.name = name; output->bytecodes.flex = ECL_NIL; + /* Technically we could deal with a smaller vector because variables are + unbound, so there is a maximal number of locals bound simultaneously. */ + c_env_sync_width(new_c_env); + output->bytecodes.nlcl = ecl_make_fixnum(new_c_env->env_width); old_c_env->load_time_forms = new_c_env->load_time_forms; diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 3d5a18583..0aaec7b9d 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -139,10 +139,11 @@ push_lex(cl_object stack, cl_object new) cl_index fillp = stack->vector.fillp; cl_index dim = stack->vector.dim; if (fillp == dim) { - cl_index new_dim = dim + dim/2 + 1; - cl_object new_stack = make_lex(new_dim); - ecl_copy_subarray(new_stack, 0, stack, 0, fillp); - stack->vector = new_stack->vector; + ecl_miscompilation_error(); + /* cl_index new_dim = dim + dim/2 + 1; */ + /* cl_object new_stack = make_lex(new_dim); */ + /* ecl_copy_subarray(new_stack, 0, stack, 0, fillp); */ + /* stack->vector = new_stack->vector; */ } stack->vector.self.t[fillp++] = new; stack->vector.fillp = fillp; @@ -350,9 +351,10 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes) const cl_env_ptr the_env = frame->frame.env; volatile cl_index frame_index = 0; cl_opcode *vector = (cl_opcode*)bytecodes->bytecodes.code; + cl_index nlcl = ecl_fixnum(bytecodes->bytecodes.nlcl); cl_object *data = bytecodes->bytecodes.data->vector.self.t; cl_object lex_env = closure; - cl_object reg0 = ECL_NIL, reg1 = ECL_NIL, lcl_env = make_lex(0); + cl_object reg0 = ECL_NIL, reg1 = ECL_NIL, lcl_env = make_lex(nlcl); cl_index narg; struct ecl_stack_frame frame_aux; volatile struct ecl_ihs_frame ihs; diff --git a/src/c/printer/write_code.d b/src/c/printer/write_code.d index 160a377d9..227c7526c 100644 --- a/src/c/printer/write_code.d +++ b/src/c/printer/write_code.d @@ -30,6 +30,7 @@ _ecl_write_bytecodes_readably(cl_object x, cl_object stream, cl_object lex) code_l, x->bytecodes.data, x->bytecodes.flex, + x->bytecodes.nlcl, x->bytecodes.file, x->bytecodes.file_position), stream); diff --git a/src/c/read.d b/src/c/read.d index 4fba0b93b..d0cf7c42a 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -769,6 +769,10 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d) x = ECL_CONS_CDR(x); rv->bytecodes.flex = nth; + nth = ECL_CONS_CAR(x); + x = ECL_CONS_CDR(x); + rv->bytecodes.nlcl = nth; + if (ECL_ATOM(x)) { nth = ECL_NIL; } else { @@ -1257,6 +1261,7 @@ do_patch_sharp(cl_object x, cl_object table) x->bytecodes.definition = do_patch_sharp(x->bytecodes.definition, table); x->bytecodes.data = do_patch_sharp(x->bytecodes.data, table); x->bytecodes.flex = do_patch_sharp(x->bytecodes.flex, table); + x->bytecodes.nlcl = do_patch_sharp(x->bytecodes.nlcl, table); break; } default:; diff --git a/src/c/serialize.d b/src/c/serialize.d index 44ecfe1f4..b8945e37a 100644 --- a/src/c/serialize.d +++ b/src/c/serialize.d @@ -328,6 +328,7 @@ serialize_one(pool_t pool, cl_object what) buffer->bytecodes.definition = enqueue(pool, buffer->bytecodes.definition); buffer->bytecodes.data = enqueue(pool, buffer->bytecodes.data); buffer->bytecodes.flex = enqueue(pool, buffer->bytecodes.flex); + buffer->bytecodes.nlcl = enqueue(pool, buffer->bytecodes.nlcl); buffer->bytecodes.file = enqueue(pool, buffer->bytecodes.file); buffer->bytecodes.file_position = enqueue(pool, buffer->bytecodes.file_position); buffer->bytecodes.code_size = serialize_bits(pool, buffer->bytecodes.code, @@ -616,6 +617,7 @@ fixup(cl_object o, cl_object *o_list) o->bytecodes.definition = get_object(o->bytecodes.definition, o_list); o->bytecodes.data = get_object(o->bytecodes.data, o_list); o->bytecodes.flex = get_object(o->bytecodes.flex, o_list); + o->bytecodes.nlcl = get_object(o->bytecodes.nlcl, o_list); o->bytecodes.file = get_object(o->bytecodes.file, o_list); o->bytecodes.file_position = get_object(o->bytecodes.file_position, o_list); o->bytecodes.entry = _ecl_bytecodes_dispatch_vararg; diff --git a/src/h/internal.h b/src/h/internal.h index 2c9bec5c3..8f4a96606 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -250,8 +250,9 @@ struct cl_compiler_env { * with make-load-form */ cl_object lex_env; /* Lexical env. for eval-when */ cl_object code_walker; /* Value of SI:*CODE-WALKER* */ - cl_index env_depth; - cl_index env_size; + cl_index env_depth; /* Environment nesting level */ + cl_index env_width; /* Environment maximal size */ + cl_index env_size; /* Environment current size */ int mode; bool stepping; bool function_boundary_crossed; diff --git a/src/h/object.h b/src/h/object.h index 1f9b581a2..a82be9027 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -768,11 +768,12 @@ struct ecl_bytecodes { cl_object name; /* function name */ cl_object definition; /* function definition in list form */ cl_objectfn entry; /* entry address (must match the position of - * the equivalent field in cfun) */ + the equivalent field in cfun) */ cl_index code_size; /* number of bytecodes */ char *code; /* the intermediate language */ cl_object data; /* non-inmediate constants used in the code */ cl_object flex; /* indexes of captured objects (vector) */ + cl_object nlcl; /* max number of locals bound simultaneously */ cl_object file; /* file where it was defined... */ cl_object file_position;/* and where it was created */ };