add pic_reg

extlib/benz/attr.c

@@ -3,21 +3,20 @@
 struct pic_dict *
 pic_attr(pic_state *pic, pic_value obj)
 {
-  xh_entry *e;
+  struct pic_dict *dict;
 
-  if (pic_vtype(obj) != PIC_VTYPE_HEAP) {
+  if (! pic_obj_p(obj)) {
     pic_errorf(pic, "attribute: expected heap object, but got immediate value ~s", obj);
   }
 
-  e = xh_get_ptr(&pic->attrs, pic_ptr(obj));
+  if (! pic_reg_has(pic, pic->attrs, pic_ptr(obj))) {
-  if (e == NULL) {
+    dict = pic_make_dict(pic);
-    struct pic_dict *dict = pic_make_dict(pic);
 
-    e = xh_put_ptr(&pic->attrs, pic_ptr(obj), &dict);
+    pic_reg_set(pic, pic->attrs, pic_ptr(obj), pic_obj_value(dict));
 
-    assert(dict == xh_val(e, struct pic_dict *));
+    return dict;
   }
-  return xh_val(e, struct pic_dict *);
+  return pic_dict_ptr(pic_reg_ref(pic, pic->attrs, pic_ptr(obj)));
 }
 
 pic_value

extlib/benz/gc.c

@@ -317,6 +317,12 @@ gc_obj_is_marked(struct pic_object *obj)
   return gc_is_marked(p);
 }
 
+static bool
+gc_value_need_mark(pic_value value)
+{
+  return pic_obj_p(value) && (! gc_obj_is_marked(pic_obj_ptr(value)));
+}
+
 static void
 gc_unmark(union header *p)
 {
@@ -473,6 +479,13 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     gc_mark_object(pic, (struct pic_object *)sym->str);
     break;
   }
+  case PIC_TT_REG: {
+    struct pic_reg *reg = (struct pic_reg *)obj;
+
+    reg->prev = pic->regs;
+    pic->regs = reg;
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
 #if PIC_ENABLE_FLOAT
@@ -536,8 +549,8 @@ gc_mark_phase(pic_state *pic)
   pic_callinfo *ci;
   struct pic_proc **xhandler;
   size_t j;
-  xh_entry *it;
+
-  struct pic_object *obj;
+  assert(pic->regs == NULL);
 
   /* checkpoint */
   if (pic->cp) {
@@ -579,6 +592,11 @@ gc_mark_phase(pic_state *pic)
     gc_mark_object(pic, (struct pic_object *)pic->macros);
   }
 
+  /* attribute table */
+  if (pic->attrs) {
+    gc_mark_object(pic, (struct pic_object *)pic->attrs);
+  }
+
   /* error object */
   gc_mark(pic, pic->err);
 
@@ -602,18 +620,26 @@ gc_mark_phase(pic_state *pic)
   /* parameter table */
   gc_mark(pic, pic->ptable);
 
-  /* attributes */
+  /* registries */
   do {
-    j = 0;
+    struct pic_object *key;
+    pic_value val;
+    xh_entry *it;
+    struct pic_reg *reg;
 
-    for (it = xh_begin(&pic->attrs); it != NULL; it = xh_next(it)) {
+    j = 0;
-      if (gc_obj_is_marked(xh_key(it, struct pic_object *))) {
+    reg = pic->regs;
-        obj = (struct pic_object *)xh_val(it, struct pic_dict *);
+
-        if (! gc_obj_is_marked(obj)) {
+    while (reg != NULL) {
-          gc_mark_object(pic, obj);
+      for (it = xh_begin(&reg->hash); it != NULL; it = xh_next(it)) {
+        key = xh_key(it, struct pic_object *);
+        val = xh_val(it, pic_value);
+        if (gc_obj_is_marked(key) && gc_value_need_mark(val)) {
+          gc_mark(pic, val);
           ++j;
         }
       }
+      reg = reg->prev;
     }
   } while (j > 0);
 }
@@ -686,6 +712,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_SYMBOL: {
     break;
   }
+  case PIC_TT_REG: {
+    struct pic_reg *reg = (struct pic_reg *)obj;
+    xh_destroy(&reg->hash);
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
 #if PIC_ENABLE_FLOAT
@@ -782,14 +813,16 @@ gc_sweep_phase(pic_state *pic)
   struct heap_page *page = pic->heap->pages;
   xh_entry *it, *next;
 
-  do {
+  /* registries */
-    for (it = xh_begin(&pic->attrs); it != NULL; it = next) {
+  while (pic->regs != NULL) {
+    for (it = xh_begin(&pic->regs->hash); it != NULL; it = next) {
       next = xh_next(it);
       if (! gc_obj_is_marked(xh_key(it, struct pic_object *))) {
-        xh_del_ptr(&pic->attrs, xh_key(it, struct pic_object *));
+        xh_del_ptr(&pic->regs->hash, xh_key(it, struct pic_object *));
       }
     }
-  } while (it != NULL);
+    pic->regs = pic->regs->prev;
+  }
 
   gc_sweep_symbols(pic);
 

extlib/benz/include/picrin.h

@@ -128,7 +128,7 @@ typedef struct {
   struct pic_dict *globals;
   struct pic_dict *macros;
   pic_value libs;
-  xhash attrs;
+  struct pic_reg *attrs;
 
   pic_value ptable;
   size_t pnum;
@@ -139,6 +139,7 @@ typedef struct {
   struct pic_heap *heap;
   struct pic_object **arena;
   size_t arena_size, arena_idx;
+  struct pic_reg *regs;
 
   struct pic_port *xSTDIN, *xSTDOUT, *xSTDERR;
 
@@ -285,6 +286,7 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
 #include "picrin/symbol.h"
 #include "picrin/read.h"
 #include "picrin/vector.h"
+#include "picrin/reg.h"
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/reg.h

@@ -0,0 +1,32 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#ifndef PICRIN_REG_H
+#define PICRIN_REG_H
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+struct pic_reg {
+  PIC_OBJECT_HEADER
+  xhash hash;
+  struct pic_reg *prev;         /* for GC */
+};
+
+#define pic_reg_p(v) (pic_type(v) == PIC_TT_REG)
+#define pic_reg_ptr(v) ((struct pic_reg *)pic_ptr(v))
+
+struct pic_reg *pic_make_reg(pic_state *);
+
+pic_value pic_reg_ref(pic_state *, struct pic_reg *, void *);
+void pic_reg_set(pic_state *, struct pic_reg *, void *, pic_value);
+void pic_reg_del(pic_state *, struct pic_reg *, void *);
+bool pic_reg_has(pic_state *, struct pic_reg *, void *);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif

extlib/benz/include/picrin/value.h

@@ -163,6 +163,7 @@ enum pic_tt {
   PIC_TT_IREP,
   PIC_TT_DATA,
   PIC_TT_DICT,
+  PIC_TT_REG,
   PIC_TT_RECORD
 };
 
@@ -327,6 +328,8 @@ pic_type_repr(enum pic_tt tt)
     return "data";
   case PIC_TT_DICT:
     return "dict";
+  case PIC_TT_REG:
+    return "reg";
   case PIC_TT_RECORD:
     return "record";
   }

extlib/benz/reg.c

@@ -0,0 +1,51 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#include "picrin.h"
+
+struct pic_reg *
+pic_make_reg(pic_state *pic)
+{
+  struct pic_reg *reg;
+
+  reg = (struct pic_reg *)pic_obj_alloc(pic, sizeof(struct pic_reg), PIC_TT_REG);
+  reg->prev = NULL;
+  xh_init_ptr(&reg->hash, sizeof(pic_value));
+
+  return reg;
+}
+
+pic_value
+pic_reg_ref(pic_state *pic, struct pic_reg *reg, void *key)
+{
+  xh_entry *e;
+
+  e = xh_get_ptr(&reg->hash, key);
+  if (! e) {
+    pic_errorf(pic, "element not found for a key: ~s", pic_obj_value(key));
+  }
+  return xh_val(e, pic_value);
+}
+
+void
+pic_reg_set(pic_state PIC_UNUSED(*pic), struct pic_reg *reg, void *key, pic_value val)
+{
+  xh_put_ptr(&reg->hash, key, &val);
+}
+
+bool
+pic_reg_has(pic_state PIC_UNUSED(*pic), struct pic_reg *reg, void *key)
+{
+  return xh_get_ptr(&reg->hash, key) != NULL;
+}
+
+void
+pic_reg_del(pic_state *pic, struct pic_reg *reg, void *key)
+{
+  if (xh_get_ptr(&reg->hash, key) == NULL) {
+    pic_errorf(pic, "no slot named ~s found in registry", pic_obj_value(key));
+  }
+
+  xh_del_ptr(&reg->hash, key);
+}

extlib/benz/state.c

@@ -205,6 +205,9 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   /* memory heap */
   pic->heap = pic_heap_open(pic);
 
+  /* registries */
+  pic->regs = NULL;
+
   /* symbol table */
   xh_init_str(&pic->syms, sizeof(pic_sym *));
 
@@ -215,7 +218,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   pic->macros = NULL;
 
   /* attributes */
-  xh_init_ptr(&pic->attrs, sizeof(struct pic_dict *));
+  pic->attrs = NULL;
 
   /* features */
   pic->features = pic_nil_value();
@@ -333,6 +336,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   /* root tables */
   pic->globals = pic_make_dict(pic);
   pic->macros = pic_make_dict(pic);
+  pic->attrs = pic_make_reg(pic);
 
   /* root block */
   pic->cp = pic_malloc(pic, sizeof(pic_checkpoint));
@@ -407,8 +411,8 @@ pic_close(pic_state *pic)
   pic->err = pic_invalid_value();
   pic->globals = NULL;
   pic->macros = NULL;
+  pic->attrs = NULL;
   xh_clear(&pic->syms);
-  xh_clear(&pic->attrs);
   pic->features = pic_nil_value();
   pic->libs = pic_nil_value();
 
@@ -428,7 +432,6 @@ pic_close(pic_state *pic)
 
   /* free global stacks */
   xh_destroy(&pic->syms);
-  xh_destroy(&pic->attrs);
 
   /* free GC arena */
   allocf(pic->arena, 0);