[7] lcl_env as a vector: precise vector size

With this commit we allocate a correctly sized vector at the beginning and avoid
unnecessary resizing later.

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 =

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;
 

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;

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);

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:;

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;

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;

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  */
 };