From 64788af4b9f6feb1b4dbf992b0c4fee7a90a9d9f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Fri, 5 Feb 2016 00:30:11 +0900
Subject: [PATCH] manage ireps using reference count

---
 extlib/benz/codegen.c             | 15 ++++++++++---
 extlib/benz/gc.c                  | 35 +++++++++++++------------------
 extlib/benz/include/picrin.h      |  1 +
 extlib/benz/include/picrin/irep.h | 13 ++++++++++--
 extlib/benz/include/picrin/type.h |  3 ---
 extlib/benz/proc.c                | 28 +++++++++++++++++++++++++
 extlib/benz/state.c               | 16 ++++++++++++++
 7 files changed, 83 insertions(+), 28 deletions(-)

diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c
index 256b5f42..2470c8f8 100644
--- a/extlib/benz/codegen.c
+++ b/extlib/benz/codegen.c
@@ -694,7 +694,8 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   struct pic_irep *irep;
 
   /* create irep */
-  irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP);
+  irep = pic_malloc(pic, sizeof(struct pic_irep));
+  irep->refc = 1;
   irep->varg = cxt->rest != NULL;
   irep->argc = (int)cxt->args->len + 1;
   irep->localc = (int)cxt->locals->len;
@@ -705,6 +706,11 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   irep->pool = pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->plen);
   irep->plen = cxt->plen;
 
+  irep->list.next = pic->ireps.next;
+  irep->list.prev = &pic->ireps;
+  irep->list.next->prev = &irep->list;
+  irep->list.prev->next = &irep->list;
+
   return irep;
 }
 
@@ -1086,6 +1092,7 @@ struct pic_proc *
 pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
 {
   struct pic_irep *irep;
+  struct pic_proc *proc;
   size_t ai = pic_gc_arena_preserve(pic);
 
 #if DEBUG
@@ -1143,7 +1150,9 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
   puts("");
 #endif
 
-  SAVE(pic, ai, pic_obj_value(irep));
+  proc = pic_make_proc_irep(pic, irep, NULL);
 
-  return pic_make_proc_irep(pic, irep, NULL);
+  pic_irep_decref(pic, irep);
+
+  return proc;
 }
diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c
index 99be734d..7215cb4b 100644
--- a/extlib/benz/gc.c
+++ b/extlib/benz/gc.c
@@ -32,7 +32,6 @@ struct pic_object {
     struct pic_env env;
     struct pic_proc proc;
     struct pic_context cxt;
-    struct pic_irep irep;
     struct pic_port port;
     struct pic_error err;
     struct pic_lib lib;
@@ -300,7 +299,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   }
   case PIC_TT_PROC: {
     if (pic_proc_irep_p(&obj->u.proc)) {
-      gc_mark_object(pic, (struct pic_object *)obj->u.proc.u.i.irep);
       if (obj->u.proc.u.i.cxt) {
         LOOP(obj->u.proc.u.i.cxt);
       }
@@ -360,17 +358,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     LOOP(obj->u.lib.exports);
     break;
   }
-  case PIC_TT_IREP: {
-    size_t i;
-
-    for (i = 0; i < obj->u.irep.ilen; ++i) {
-      gc_mark_object(pic, (struct pic_object *)obj->u.irep.irep[i]);
-    }
-    for (i = 0; i < obj->u.irep.plen; ++i) {
-      gc_mark(pic, obj->u.irep.pool[i]);
-    }
-    break;
-  }
   case PIC_TT_DATA: {
     if (obj->u.data.type->mark) {
       obj->u.data.type->mark(pic, obj->u.data.data, gc_mark);
@@ -441,6 +428,7 @@ gc_mark_phase(pic_state *pic)
   pic_value *stack;
   pic_callinfo *ci;
   struct pic_proc **xhandler;
+  struct pic_list *list;
   size_t j;
 
   assert(pic->heap->regs == NULL);
@@ -472,6 +460,14 @@ gc_mark_phase(pic_state *pic)
     gc_mark_object(pic, (struct pic_object *)pic->arena[j]);
   }
 
+  /* ireps */
+  for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
+    struct pic_irep *irep = (struct pic_irep *)list;
+    for (j = 0; j < irep->plen; ++j) {
+      gc_mark(pic, irep->pool[j]);
+    }
+  }
+
   /* mark reserved symbols */
   M(sQUOTE); M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING);
   M(sSYNTAX_QUOTE); M(sSYNTAX_QUASIQUOTE); M(sSYNTAX_UNQUOTE); M(sSYNTAX_UNQUOTE_SPLICING);
@@ -564,12 +560,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     kh_destroy(env, &obj->u.env.map);
     break;
   }
-  case PIC_TT_IREP: {
-    pic_free(pic, obj->u.irep.code);
-    pic_free(pic, obj->u.irep.irep);
-    pic_free(pic, obj->u.irep.pool);
-    break;
-  }
   case PIC_TT_DATA: {
     if (obj->u.data.type->dtor) {
       obj->u.data.type->dtor(pic, obj->u.data.data);
@@ -588,10 +578,15 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     kh_destroy(reg, &obj->u.reg.hash);
     break;
   }
+  case PIC_TT_PROC: {
+    if (pic_proc_irep_p(&obj->u.proc)) {
+      pic_irep_decref(pic, obj->u.proc.u.i.irep);
+    }
+    break;
+  }
 
   case PIC_TT_PAIR:
   case PIC_TT_CXT:
-  case PIC_TT_PROC:
   case PIC_TT_PORT:
   case PIC_TT_ERROR:
   case PIC_TT_ID:
diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h
index 221e8380..8ee7db53 100644
--- a/extlib/benz/include/picrin.h
+++ b/extlib/benz/include/picrin.h
@@ -121,6 +121,7 @@ struct pic_state {
   struct pic_reg *globals;
   struct pic_reg *macros;
   pic_value libs;
+  struct pic_list ireps;        /* chain */
 
   pic_reader reader;
   xFILE files[XOPEN_MAX];
diff --git a/extlib/benz/include/picrin/irep.h b/extlib/benz/include/picrin/irep.h
index 872f3d23..63d9a8eb 100644
--- a/extlib/benz/include/picrin/irep.h
+++ b/extlib/benz/include/picrin/irep.h
@@ -20,16 +20,25 @@ typedef struct {
   } u;
 } pic_code;
 
+struct pic_list {
+  struct pic_list *prev, *next;
+};
+
 struct pic_irep {
-  PIC_OBJECT_HEADER
+  struct pic_list list;
+  int refc;
   pic_code *code;
   int argc, localc, capturec;
   bool varg;
   struct pic_irep **irep;
+  size_t ilen;
   pic_value *pool;
-  size_t ilen, plen;
+  size_t plen;
 };
 
+void pic_irep_incref(pic_state *, struct pic_irep *);
+void pic_irep_decref(pic_state *, struct pic_irep *);
+
 pic_sym *pic_resolve(pic_state *, pic_value, struct pic_env *);
 pic_value pic_expand(pic_state *, pic_value, struct pic_env *);
 pic_value pic_analyze(pic_state *, pic_value);
diff --git a/extlib/benz/include/picrin/type.h b/extlib/benz/include/picrin/type.h
index 6cdccd06..b0a27e2e 100644
--- a/extlib/benz/include/picrin/type.h
+++ b/extlib/benz/include/picrin/type.h
@@ -158,7 +158,6 @@ enum pic_tt {
   PIC_TT_RECORD,
   PIC_TT_BOX,
   PIC_TT_CXT,
-  PIC_TT_IREP,
   PIC_TT_CP
 };
 
@@ -305,8 +304,6 @@ pic_type_repr(enum pic_tt tt)
     return "env";
   case PIC_TT_LIB:
     return "lib";
-  case PIC_TT_IREP:
-    return "irep";
   case PIC_TT_DATA:
     return "data";
   case PIC_TT_DICT:
diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c
index 041d2464..ab067ced 100644
--- a/extlib/benz/proc.c
+++ b/extlib/benz/proc.c
@@ -4,6 +4,33 @@
 
 #include "picrin.h"
 
+void
+pic_irep_incref(pic_state PIC_UNUSED(*pic), struct pic_irep *irep)
+{
+  irep->refc++;
+}
+
+void
+pic_irep_decref(pic_state *pic, struct pic_irep *irep)
+{
+  size_t i;
+
+  if (--irep->refc == 0) {
+    pic_free(pic, irep->code);
+    pic_free(pic, irep->pool);
+
+    /* unchain before decref children ireps */
+    irep->list.prev->next = irep->list.next;
+    irep->list.next->prev = irep->list.prev;
+
+    for (i = 0; i < irep->ilen; ++i) {
+      pic_irep_decref(pic, irep->irep[i]);
+    }
+    pic_free(pic, irep->irep);
+    pic_free(pic, irep);
+  }
+}
+
 struct pic_proc *
 pic_make_proc(pic_state *pic, pic_func_t func)
 {
@@ -25,6 +52,7 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cx
   proc->tag = PIC_PROC_TAG_IREP;
   proc->u.i.irep = irep;
   proc->u.i.cxt = cxt;
+  pic_irep_incref(pic, irep);
   return proc;
 }
 
diff --git a/extlib/benz/state.c b/extlib/benz/state.c
index ffc3d97b..2459db5a 100644
--- a/extlib/benz/state.c
+++ b/extlib/benz/state.c
@@ -316,6 +316,10 @@ pic_open(pic_allocf allocf, void *userdata)
   pic->libs = pic_nil_value();
   pic->lib = NULL;
 
+  /* ireps */
+  pic->ireps.next = &pic->ireps;
+  pic->ireps.prev = &pic->ireps;
+
   /* raised error object */
   pic->err = pic_invalid_value();
 
@@ -478,6 +482,18 @@ pic_close(pic_state *pic)
   /* free all heap objects */
   pic_gc_run(pic);
 
+#if 0
+  {
+    /* FIXME */
+    int i = 0;
+    struct pic_list *list;
+    for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
+      i++;
+    }
+    printf("%d\n", i);
+  }
+#endif
+
   /* flush all xfiles */
   xfflush(pic, NULL);