store irep objects inside parent irep object

include/picrin.h

@@ -87,8 +87,6 @@ typedef struct {
   pic_value lib_tbl;
   struct pic_lib *lib;
 
-  struct pic_irep **irep;
-  size_t ilen, icapa;
   pic_value *pool;
   size_t plen, pcapa;
 

include/picrin/irep.h

@@ -61,10 +61,11 @@ struct pic_code {
 struct pic_irep {
   PIC_OBJECT_HEADER
   struct pic_code *code;
-  size_t clen;
   int argc, localc;
   unsigned *cv_tbl, cv_num;
   bool varg;
+  struct pic_irep **irep;
+  size_t clen, ilen;
 };
 
 void pic_dump_irep(pic_state *, struct pic_irep *);

src/codegen.c

@@ -32,6 +32,7 @@ new_irep(pic_state *pic)
   irep->argc = -1;
   irep->localc = -1;
   irep->varg = false;
+  irep->irep = NULL;
   return irep;
 }
 
@@ -50,6 +51,9 @@ typedef struct codegen_scope {
   /* actual bit code sequence */
   struct pic_code *code;
   size_t clen, ccapa;
+  /* child ireps */
+  struct pic_irep **irep;
+  size_t ilen, icapa;
 
   struct codegen_scope *up;
 } codegen_scope;
@@ -69,6 +73,9 @@ new_global_scope(pic_state *pic)
   scope->code = (struct pic_code *)pic_alloc(pic, sizeof(struct pic_code) * 1024);
   scope->clen = 0;
   scope->ccapa = 1024;
+  scope->irep = (struct pic_irep **)pic_calloc(pic, PIC_IREP_SIZE, sizeof(struct pic_irep *));
+  scope->ilen = 0;
+  scope->icapa = PIC_IREP_SIZE;
 
   return scope;
 }
@@ -111,6 +118,10 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope)
   new_scope->clen = 0;
   new_scope->ccapa = 1024;
 
+  new_scope->irep = (struct pic_irep **)pic_calloc(pic, PIC_IREP_SIZE, sizeof(struct pic_irep *));
+  new_scope->ilen = 0;
+  new_scope->icapa = PIC_IREP_SIZE;
+
   return new_scope;
 }
 
@@ -317,24 +328,19 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
       else if (sym == pic->sLAMBDA) {
 	int k;
 
-	if (pic->ilen >= pic->icapa) {
+	if (scope->ilen >= scope->icapa) {
-
 #if DEBUG
 	  puts("irep realloced");
 #endif
-
+	  scope->irep = (struct pic_irep **)pic_realloc(pic, scope->irep, scope->icapa * 2);
-	  pic->irep = (struct pic_irep **)pic_realloc(pic, pic->irep, pic->icapa * 2);
+	  scope->icapa *= 2;
-	  pic->icapa *= 2;
 	}
-	k = pic->ilen++;
+	k = scope->ilen++;
 	scope->code[scope->clen].insn = OP_LAMBDA;
 	scope->code[scope->clen].u.i = k;
 	scope->clen++;
 
-        /* prevent GC from hanging */
+	scope->irep[k] = codegen_lambda(state, obj);
-        pic->irep[k] = NULL;
-
-	pic->irep[k] = codegen_lambda(state, obj);
 	break;
       }
       else if (sym == pic->sIF) {
@@ -756,10 +762,10 @@ lift_cv(pic_state *pic, struct pic_irep *irep, int d)
       /* pass */
       break;
     case OP_LAMBDA:
-      if (pic->irep[c.u.i]->cv_num == 0)
+      if (irep->irep[c.u.i]->cv_num == 0)
-	lift_cv(pic, pic->irep[c.u.i], d);
+	lift_cv(pic, irep->irep[c.u.i], d);
       else
-	lift_cv(pic, pic->irep[c.u.i], d + 1);
+	lift_cv(pic, irep->irep[c.u.i], d + 1);
       break;
     case OP_CREF:
     case OP_CSET:
@@ -783,11 +789,11 @@ slide_cv(pic_state *pic, unsigned *cv_tbl, unsigned cv_num, struct pic_irep *ire
       /* pass */
       break;
     case OP_LAMBDA:
-      if (pic->irep[c.u.i]->cv_num == 0) {
+      if (irep->irep[c.u.i]->cv_num == 0) {
-	slide_cv(pic, cv_tbl, cv_num, pic->irep[c.u.i], d);
+	slide_cv(pic, cv_tbl, cv_num, irep->irep[c.u.i], d);
       }
       else {
-	slide_cv(pic, cv_tbl, cv_num, pic->irep[c.u.i], d + 1);
+	slide_cv(pic, cv_tbl, cv_num, irep->irep[c.u.i], d + 1);
       }
       break;
     case OP_CREF:
@@ -847,6 +853,8 @@ codegen_lambda(codegen_state *state, pic_value obj)
     irep->localc = state->scope->localc;
     irep->code = pic_realloc(pic, state->scope->code, sizeof(struct pic_code) * state->scope->clen);
     irep->clen = state->scope->clen;
+    irep->irep = pic_realloc(pic, state->scope->irep, sizeof(struct pic_irep *) * state->scope->ilen);
+    irep->ilen = state->scope->ilen;
 
     /* fixup local references */
     for (i = 0; i < irep->clen; ++i) {
@@ -937,6 +945,8 @@ pic_codegen(pic_state *pic, pic_value obj)
   irep->localc = 0;
   irep->code = pic_realloc(pic, state->scope->code, sizeof(struct pic_code) * state->scope->clen);
   irep->clen = state->scope->clen;
+  irep->irep = pic_realloc(pic, state->scope->irep, sizeof(struct pic_irep *) * state->scope->ilen);
+  irep->ilen = state->scope->ilen;
   irep->cv_num = 0;
   irep->cv_tbl = NULL;
 

src/gc.c

@@ -432,6 +432,12 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_IREP: {
+    struct pic_irep *irep = (struct pic_irep *)obj;
+    int i;
+
+    for (i = 0; i < irep->ilen; ++i) {
+      gc_mark_object(pic, (struct pic_object *)irep->irep[i]);
+    }
     break;
   }
   case PIC_TT_NIL:
@@ -495,12 +501,6 @@ gc_mark_phase(pic_state *pic)
     gc_mark(pic, pic->globals[i]);
   }
 
-  /* irep */
-  for (i = 0; i < pic->ilen; ++i) {
-    if (pic->irep[i])
-      gc_mark_object(pic, (struct pic_object *)pic->irep[i]);
-  }
-
   /* pool */
   for (i = 0; i < pic->plen; ++i) {
     gc_mark(pic, pic->pool[i]);

src/state.c

@@ -59,11 +59,6 @@ pic_open(int argc, char *argv[], char **envp)
   pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
   pic->uniq_sym_count = 0;
 
-  /* irep */
-  pic->irep = (struct pic_irep **)calloc(PIC_IREP_SIZE, sizeof(struct pic_irep *));
-  pic->ilen = 0;
-  pic->icapa = PIC_IREP_SIZE;
-
   /* globals */
   pic->global_tbl = xh_new();
   pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
@@ -130,7 +125,6 @@ pic_close(pic_state *pic)
   free(pic->rescue);
   free(pic->globals);
   free(pic->pool);
-  free(pic->irep);
 
   pic->glen = 0;
   pic->rlen = 0;

src/vm.c

@@ -657,9 +657,19 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       NEXT;
     }
     CASE(OP_LAMBDA) {
+      pic_value self;
+      struct pic_irep *irep;
       struct pic_proc *proc;
 
-      proc = pic_proc_new_irep(pic, pic->irep[c.u.i], pic->ci->env);
+      self = pic->ci->fp[0];
+      if (! pic_proc_p(self)) {
+        pic_error(pic, "logic flaw");
+      }
+      irep = pic_proc_ptr(self)->u.irep;
+      if (pic_proc_cfunc_p(self)) {
+        pic_error(pic, "logic flaw");
+      }
+      proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env);
       PUSH(pic_obj_value(proc));
       pic_gc_arena_restore(pic, ai);
       NEXT;