manage ireps by gc

lib/debug.c

@@ -21,7 +21,7 @@ pic_get_backtrace(pic_state *pic)
     trace = pic_str_cat(pic, trace, pic_lit_value(pic, "  at "));
     trace = pic_str_cat(pic, trace, pic_lit_value(pic, "(anonymous lambda)"));
 
-    if (pic_func_p(pic, proc)) {
+    if (pic_proc_func_p(pic, proc)) {
       trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
     } else {
       trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */

lib/ext/eval.c

@@ -643,9 +643,7 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   struct irep *irep;
 
   /* create irep */
-  irep = pic_malloc(pic, sizeof(struct irep));
+  irep = (struct irep *)pic_obj_alloc(pic, sizeof(struct irep), PIC_TYPE_IREP);
-  irep->list.next = irep->list.prev = 0;
-  irep->refc = 1;
   irep->varg = pic_sym_p(pic, cxt->rest);
   irep->argc = pic_vec_len(pic, cxt->args) + 1;
   irep->localc = pic_vec_len(pic, cxt->locals);
@@ -661,13 +659,6 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   irep->nnums = cxt->flen;
   irep->npool = cxt->plen;
 
-  if (irep->npool > 0) {
-    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;
 }
 
@@ -1072,7 +1063,6 @@ static pic_value
 pic_compile(pic_state *pic, pic_value obj)
 {
   struct irep *irep;
-  pic_value proc;
   size_t ai = pic_enter(pic);
 
 #if 0
@@ -1106,11 +1096,7 @@ pic_compile(pic_state *pic, pic_value obj)
   /* codegen */
   irep = pic_codegen(pic, obj);
 
-  proc = pic_make_proc_irep(pic, irep, NULL);
+  return pic_make_proc_irep(pic, irep, NULL);
-
-  pic_irep_decref(pic, irep);
-
-  return proc;
 }
 
 pic_value

lib/ext/write.c

@@ -448,8 +448,10 @@ typename(pic_state *pic, pic_value obj)
     return "identifier";
   case PIC_TYPE_CXT:
     return "context";
-  case PIC_TYPE_FUNC:
   case PIC_TYPE_IREP:
+    return "irep";
+  case PIC_TYPE_PROC_FUNC:
+  case PIC_TYPE_PROC_IREP:
     return "procedure";
   case PIC_TYPE_ENV:
     return "environment";

lib/gc.c

@@ -33,6 +33,7 @@ struct object {
     struct port port;
     struct error err;
     struct checkpoint cp;
+    struct irep irep;
   } u;
 };
 
@@ -342,16 +343,27 @@ gc_mark_object(pic_state *pic, struct object *obj)
     }
     break;
   }
-  case PIC_TYPE_FUNC: {
+  case PIC_TYPE_PROC_FUNC: {
     int i;
     for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
       gc_mark(pic, obj->u.proc.locals[i]);
     }
     break;
   }
-  case PIC_TYPE_IREP: {
+  case PIC_TYPE_PROC_IREP: {
     if (obj->u.proc.u.i.cxt) {
-      LOOP(obj->u.proc.u.i.cxt);
+      gc_mark_object(pic, (struct object *)obj->u.proc.u.i.cxt);
+    }
+    LOOP(obj->u.proc.u.i.irep);
+    break;
+  }
+  case PIC_TYPE_IREP: {
+    size_t i;
+    for (i = 0; i < obj->u.irep.npool; ++i) {
+      gc_mark_object(pic, obj->u.irep.pool[i]);
+    }
+    for (i = 0; i < obj->u.irep.nirep; ++i) {
+      gc_mark_object(pic, (struct object *)obj->u.irep.irep[i]);
     }
     break;
   }
@@ -451,7 +463,6 @@ gc_mark_phase(pic_state *pic)
 {
   pic_value *stack;
   struct callinfo *ci;
-  struct list_head *list;
   int it;
   size_t j;
 
@@ -479,14 +490,6 @@ gc_mark_phase(pic_state *pic)
     gc_mark_object(pic, (struct object *)pic->arena[j]);
   }
 
-  /* ireps */
-  for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
-    struct irep *irep = (struct irep *)list;
-    for (j = 0; j < irep->npool; ++j) {
-      gc_mark_object(pic, irep->pool[j]);
-    }
-  }
-
   /* global variables */
   gc_mark(pic, pic->globals);
 
@@ -580,7 +583,12 @@ gc_finalize_object(pic_state *pic, struct object *obj)
     break;
   }
   case PIC_TYPE_IREP: {
-    pic_irep_decref(pic, obj->u.proc.u.i.irep);
+    struct irep *irep = &obj->u.irep;
+    pic_free(pic, irep->code);
+    pic_free(pic, irep->ints);
+    pic_free(pic, irep->nums);
+    pic_free(pic, irep->pool);
+    pic_free(pic, irep->irep);
     break;
   }
   case PIC_TYPE_PORT: {
@@ -594,7 +602,8 @@ gc_finalize_object(pic_state *pic, struct object *obj)
   case PIC_TYPE_ID:
   case PIC_TYPE_RECORD:
   case PIC_TYPE_CP:
-  case PIC_TYPE_FUNC:
+  case PIC_TYPE_PROC_FUNC:
+  case PIC_TYPE_PROC_IREP:
     break;
 
   default:

lib/include/picrin/value.h

@@ -10,34 +10,35 @@ extern "C" {
 #endif
 
 enum {
-  PIC_TYPE_INVALID = 1,
+  PIC_TYPE_INVALID   = 1,
-  PIC_TYPE_FLOAT   = 2,
+  PIC_TYPE_FLOAT     = 2,
-  PIC_TYPE_INT     = 3,
+  PIC_TYPE_INT       = 3,
-  PIC_TYPE_CHAR    = 4,
+  PIC_TYPE_CHAR      = 4,
-  PIC_TYPE_EOF     = 5,
+  PIC_TYPE_EOF       = 5,
-  PIC_TYPE_UNDEF   = 6,
+  PIC_TYPE_UNDEF     = 6,
-  PIC_TYPE_TRUE    = 8,
+  PIC_TYPE_TRUE      = 8,
-  PIC_TYPE_NIL     = 7,
+  PIC_TYPE_NIL       = 7,
-  PIC_TYPE_FALSE   = 9,
+  PIC_TYPE_FALSE     = 9,
-  PIC_IVAL_END     = 10,
+  PIC_IVAL_END       = 10,
 /* -------------------- */
-  PIC_TYPE_STRING  = 16,
+  PIC_TYPE_STRING    = 16,
-  PIC_TYPE_VECTOR  = 17,
+  PIC_TYPE_VECTOR    = 17,
-  PIC_TYPE_BLOB    = 18,
+  PIC_TYPE_BLOB      = 18,
-  PIC_TYPE_PORT    = 20,
+  PIC_TYPE_PORT      = 20,
-  PIC_TYPE_ERROR   = 21,
+  PIC_TYPE_ERROR     = 21,
-  PIC_TYPE_ID      = 22,
+  PIC_TYPE_ID        = 22,
-  PIC_TYPE_ENV     = 23,
+  PIC_TYPE_ENV       = 23,
-  PIC_TYPE_DATA    = 24,
+  PIC_TYPE_DATA      = 24,
-  PIC_TYPE_DICT    = 25,
+  PIC_TYPE_DICT      = 25,
-  PIC_TYPE_WEAK    = 26,
+  PIC_TYPE_WEAK      = 26,
-  PIC_TYPE_RECORD  = 27,
+  PIC_TYPE_RECORD    = 27,
-  PIC_TYPE_SYMBOL  = 28,
+  PIC_TYPE_SYMBOL    = 28,
-  PIC_TYPE_PAIR    = 29,
+  PIC_TYPE_PAIR      = 29,
-  PIC_TYPE_CXT     = 30,
+  PIC_TYPE_CXT       = 30,
-  PIC_TYPE_CP      = 31,
+  PIC_TYPE_CP        = 31,
-  PIC_TYPE_FUNC    = 32,
+  PIC_TYPE_PROC_FUNC = 32,
-  PIC_TYPE_IREP    = 33
+  PIC_TYPE_PROC_IREP = 33,
+  PIC_TYPE_IREP      = 34
 };
 
 #if !PIC_NAN_BOXING
@@ -221,7 +222,8 @@ DEFPRED(pic_rec_p, PIC_TYPE_RECORD)
 DEFPRED(pic_sym_p, PIC_TYPE_SYMBOL)
 DEFPRED(pic_pair_p, PIC_TYPE_PAIR)
 DEFPRED(pic_cp_p, PIC_TYPE_CP)
-DEFPRED(pic_func_p, PIC_TYPE_FUNC)
+DEFPRED(pic_proc_func_p, PIC_TYPE_PROC_FUNC)
+DEFPRED(pic_proc_irep_p, PIC_TYPE_PROC_IREP)
 DEFPRED(pic_irep_p, PIC_TYPE_IREP)
 
 PIC_STATIC_INLINE bool
@@ -233,7 +235,7 @@ pic_bool_p(pic_state *pic, pic_value obj)
 PIC_STATIC_INLINE bool
 pic_proc_p(pic_state *pic, pic_value o)
 {
-  return pic_func_p(pic, o) || pic_irep_p(pic, o);
+  return pic_proc_func_p(pic, o) || pic_proc_irep_p(pic, o);
 }
 
 PIC_STATIC_INLINE bool

lib/object.h

@@ -90,6 +90,24 @@ struct data {
   void *data;
 };
 
+struct code {
+  int insn;
+  int a;
+  int b;
+};
+
+struct irep {
+  OBJECT_HEADER
+  int argc, localc, capturec;
+  bool varg;
+  struct code *code;
+  struct irep **irep;
+  int *ints;
+  double *nums;
+  struct object **pool;
+  size_t ncode, nirep, nints, nnums, npool;
+};
+
 struct context {
   OBJECT_HEADER
   pic_value *regs;
@@ -260,6 +278,7 @@ DEFPTR(pic_port_ptr, struct port)
 DEFPTR(pic_error_ptr, struct error)
 DEFPTR(pic_rec_ptr, struct record)
 DEFPTR(pic_cp_ptr, struct checkpoint)
+DEFPTR(pic_irep_ptr, struct irep)
 
 struct object *pic_obj_alloc(pic_state *, size_t, int type);
 

lib/proc.c

@@ -268,8 +268,6 @@ pic_closure_ref(pic_state *pic, int n)
 {
   pic_value self = GET_PROC(pic);
 
-  assert(pic_func_p(pic, self));
-
   if (n < 0 || pic_proc_ptr(pic, self)->u.f.localc <= n) {
     pic_error(pic, "pic_closure_ref: index out of range", 1, pic_int_value(pic, n));
   }
@@ -281,8 +279,6 @@ pic_closure_set(pic_state *pic, int n, pic_value v)
 {
   pic_value self = GET_PROC(pic);
 
-  assert(pic_func_p(pic, self));
-
   if (n < 0 || pic_proc_ptr(pic, self)->u.f.localc <= n) {
     pic_error(pic, "pic_closure_ref: index out of range", 1, pic_int_value(pic, n));
   }
@@ -542,7 +538,7 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
       ci->fp = pic->sp - c.a;
       ci->irep = NULL;
       ci->cxt = NULL;
-      if (proc->tt == PIC_TYPE_FUNC) {
+      if (proc->tt == PIC_TYPE_PROC_FUNC) {
 
         /* invoke! */
         v = proc->u.f.func(pic);
@@ -821,44 +817,13 @@ pic_vcall(pic_state *pic, pic_value proc, int n, va_list ap)
   return pic_apply(pic, proc, n, args);
 }
 
-void
-pic_irep_incref(pic_state *PIC_UNUSED(pic), struct irep *irep)
-{
-  irep->refc++;
-}
-
-void
-pic_irep_decref(pic_state *pic, struct irep *irep)
-{
-  size_t i;
-
-  if (--irep->refc == 0) {
-    pic_free(pic, irep->code);
-    pic_free(pic, irep->ints);
-    pic_free(pic, irep->nums);
-    pic_free(pic, irep->pool);
-
-    /* unchain before decref children ireps */
-    if (irep->list.prev) {      /* && irep->list.next */
-      irep->list.prev->next = irep->list.next;
-      irep->list.next->prev = irep->list.prev;
-    }
-
-    for (i = 0; i < irep->nirep; ++i) {
-      pic_irep_decref(pic, irep->irep[i]);
-    }
-    pic_free(pic, irep->irep);
-    pic_free(pic, irep);
-  }
-}
-
 pic_value
 pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
 {
   struct proc *proc;
   int i;
 
-  proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_FUNC);
+  proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC_FUNC);
   proc->u.f.func = func;
   proc->u.f.localc = n;
   for (i = 0; i < n; ++i) {
@@ -872,10 +837,9 @@ pic_make_proc_irep(pic_state *pic, struct irep *irep, struct context *cxt)
 {
   struct proc *proc;
 
-  proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_IREP);
+  proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_PROC_IREP);
   proc->u.i.irep = irep;
   proc->u.i.cxt = cxt;
-  pic_irep_incref(pic, irep);
   return obj_value(pic, proc);
 }
 

lib/state.c

@@ -231,10 +231,6 @@ pic_open(pic_allocf allocf, void *userdata)
   kh_init(ltable, &pic->ltable);
   pic->lib = NULL;
 
-  /* ireps */
-  pic->ireps.next = &pic->ireps;
-  pic->ireps.prev = &pic->ireps;
-
   /* raised error object */
   pic->panicf = NULL;
   pic->err = pic_invalid_value(pic);

lib/state.h

@@ -56,7 +56,6 @@ struct pic_state {
   pic_value globals;            /* weak */
   pic_value macros;             /* weak */
   khash_t(ltable) ltable;
-  struct list_head ireps;
 
   bool gc_enable;
   struct heap *heap;

lib/vm.h

@@ -52,32 +52,6 @@ enum {
   OP_STOP
 };
 
-struct code {
-  int insn;
-  int a;
-  int b;
-};
-
-struct list_head {
-  struct list_head *prev, *next;
-};
-
-struct irep {
-  struct list_head list;
-  unsigned refc;
-  int argc, localc, capturec;
-  bool varg;
-  struct code *code;
-  struct irep **irep;
-  int *ints;
-  double *nums;
-  struct object **pool;
-  size_t ncode, nirep, nints, nnums, npool;
-};
-
-void pic_irep_incref(pic_state *, struct irep *);
-void pic_irep_decref(pic_state *, struct irep *);
-
 #if defined(__cplusplus)
 }
 #endif