Merge branch 'fast-global-access2'

extlib/benz/codegen.c

@@ -578,9 +578,6 @@ typedef struct codegen_context {
   /* constant object pool */
   pic_value *pool;
   size_t plen, pcapa;
-  /* symbol pool */
-  pic_sym **syms;
-  size_t slen, scapa;
 
   struct codegen_context *up;
 } codegen_context;
@@ -609,10 +606,6 @@ codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up,
   cxt->plen = 0;
   cxt->pcapa = PIC_POOL_SIZE;
 
-  cxt->syms = pic_calloc(pic, PIC_SYMS_SIZE, sizeof(pic_sym *));
-  cxt->slen = 0;
-  cxt->scapa = PIC_SYMS_SIZE;
-
   create_activation(pic, cxt);
 }
 
@@ -633,8 +626,6 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   irep->ilen = cxt->ilen;
   irep->pool = pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->plen);
   irep->plen = cxt->plen;
-  irep->syms = pic_realloc(pic, cxt->syms, sizeof(pic_sym *) * cxt->slen);
-  irep->slen = cxt->slen;
 
   return irep;
 }
@@ -647,7 +638,6 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
   } while (0)
 
 #define check_code_size(pic, cxt) check_size(pic, cxt, c, code, pic_code)
-#define check_syms_size(pic, cxt) check_size(pic, cxt, s, syms, pic_sym *)
 #define check_irep_size(pic, cxt) check_size(pic, cxt, i, irep, struct pic_irep *)
 #define check_pool_size(pic, cxt) check_size(pic, cxt, p, pool, pic_value)
 
@@ -716,18 +706,19 @@ index_local(codegen_context *cxt, pic_sym *sym)
 }
 
 static int
-index_symbol(pic_state *pic, codegen_context *cxt, pic_sym *sym)
+index_global(pic_state *pic, codegen_context *cxt, pic_sym *name)
 {
-  size_t i;
+  extern pic_value pic_vm_gref_slot(pic_state *, pic_sym *);
+  int pidx;
+  pic_value slot;
 
-  for (i = 0; i < cxt->slen; ++i) {
-    if (cxt->syms[i] == sym) {
-      return i;
-    }
-  }
-  check_syms_size(pic, cxt);
-  cxt->syms[cxt->slen++] = sym;
-  return i;
+  slot = pic_vm_gref_slot(pic, name);
+
+  check_pool_size(pic, cxt);
+  pidx = (int)cxt->plen++;
+  cxt->pool[pidx] = slot;
+
+  return pidx;
 }
 
 static void
@@ -758,7 +749,10 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
 
   sym = pic_sym_ptr(pic_car(pic, obj));
   if (sym == pic->sGREF) {
-    emit_i(pic, cxt, OP_GREF, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, obj, 1))));
+    pic_sym *name;
+
+    name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
+    emit_i(pic, cxt, OP_GREF, index_global(pic, cxt, name));
     emit_ret(pic, cxt, tailpos);
   }
   else if (sym == pic->sCREF) {
@@ -797,7 +791,10 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
   var = pic_list_ref(pic, obj, 1);
   type = pic_sym_ptr(pic_list_ref(pic, var, 0));
   if (type == pic->sGREF) {
-    emit_i(pic, cxt, OP_GSET, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, var, 1))));
+    pic_sym *name;
+
+    name = pic_sym_ptr(pic_list_ref(pic, var, 1));
+    emit_i(pic, cxt, OP_GSET, index_global(pic, cxt, name));
     emit_ret(pic, cxt, tailpos);
   }
   else if (type == pic->sCREF) {

extlib/benz/gc.c

@@ -435,9 +435,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     for (i = 0; i < irep->plen; ++i) {
       gc_mark(pic, irep->pool[i]);
     }
-    for (i = 0; i < irep->slen; ++i) {
-      gc_mark_object(pic, (struct pic_object *)irep->syms[i]);
-    }
     break;
   }
   case PIC_TT_DATA: {
@@ -490,6 +487,12 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     }
     break;
   }
+  case PIC_TT_BOX: {
+    struct pic_box *box = (struct pic_box *)obj;
+
+    gc_mark(pic, box->value);
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
 #if PIC_ENABLE_FLOAT
@@ -706,7 +709,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     pic_free(pic, irep->code);
     pic_free(pic, irep->irep);
     pic_free(pic, irep->pool);
-    pic_free(pic, irep->syms);
     break;
   }
   case PIC_TT_DATA: {
@@ -737,6 +739,9 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_CP: {
     break;
   }
+  case PIC_TT_BOX: {
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
 #if PIC_ENABLE_FLOAT

extlib/benz/include/picrin.h

@@ -108,6 +108,9 @@ struct pic_state {
   pic_value pCONS, pCAR, pCDR, pNILP, pPAIRP, pSYMBOLP, pNOT;
   pic_value pADD, pSUB, pMUL, pDIV, pEQ, pLT, pLE, pGT, pGE;
 
+  pic_value cCONS, cCAR, cCDR, cNILP, cPAIRP, cSYMBOLP, cNOT;
+  pic_value cADD, cSUB, cMUL, cDIV, cEQ, cLT, cLE, cGT, cGE;
+
   struct pic_lib *PICRIN_BASE;
   struct pic_lib *PICRIN_USER;
 
@@ -268,6 +271,7 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
 #include "picrin/symbol.h"
 #include "picrin/vector.h"
 #include "picrin/reg.h"
+#include "picrin/box.h"
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/box.h

@@ -0,0 +1,53 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#ifndef PICRIN_BOX_H
+#define PICRIN_BOX_H
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+struct pic_box {
+  PIC_OBJECT_HEADER
+  pic_value value;
+};
+
+#define pic_box_p(v) (pic_type(v) == PIC_TT_BOX)
+#define pic_box_ptr(o) ((struct pic_box *)pic_ptr(o))
+
+PIC_INLINE pic_value
+pic_box(pic_state *pic, pic_value value)
+{
+  struct pic_box *box;
+
+  box = (struct pic_box *)pic_obj_alloc(pic, sizeof(struct pic_box), PIC_TT_BOX);
+  box->value = value;
+
+  return pic_obj_value(box);
+}
+
+PIC_INLINE pic_value
+pic_unbox(pic_state *pic, pic_value box)
+{
+  if (! pic_box_p(box)) {
+    pic_errorf(pic, "box required");
+  }
+  return pic_box_ptr(box)->value;
+}
+
+PIC_INLINE void
+pic_set_box(pic_state *pic, pic_value box, pic_value value)
+{
+  if (! pic_box_p(box)) {
+    pic_errorf(pic, "box required");
+  }
+  pic_box_ptr(box)->value = value;
+}
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif

extlib/benz/include/picrin/irep.h

@@ -74,7 +74,6 @@ struct pic_irep {
   bool varg;
   struct pic_irep **irep;
   pic_value *pool;
-  pic_sym **syms;
   size_t clen, ilen, plen, slen;
 };
 

extlib/benz/include/picrin/value.h

@@ -163,10 +163,11 @@ enum pic_tt {
   PIC_TT_DATA,
   PIC_TT_DICT,
   PIC_TT_REG,
+  PIC_TT_BOX,
   PIC_TT_RECORD,
   PIC_TT_CXT,
   PIC_TT_IREP,
-  PIC_TT_CP
+  PIC_TT_CP,
 };
 
 #define PIC_OBJECT_HEADER			\
@@ -337,6 +338,8 @@ pic_type_repr(enum pic_tt tt)
     return "reg";
   case PIC_TT_RECORD:
     return "record";
+  case PIC_TT_BOX:
+    return "box";
   case PIC_TT_CP:
     return "checkpoint";
   }

extlib/benz/state.c

@@ -118,6 +118,9 @@ pic_features(pic_state *pic)
 #define VM(uid, name)                                                   \
   pic_define_syntactic_keyword_(pic, pic->lib->env, pic_intern_cstr(pic, name), uid)
 
+#define VM3(name)                                       \
+  pic->c##name = pic_vm_gref_slot(pic, pic->u##name);
+
 #define VM2(proc, name)                         \
   proc = pic_ref(pic, pic->lib, name)
 
@@ -125,6 +128,7 @@ static void
 pic_init_core(pic_state *pic)
 {
   void pic_define_syntactic_keyword_(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
+  pic_value pic_vm_gref_slot(pic_state *, pic_sym *);
 
   pic_init_features(pic);
 
@@ -182,6 +186,23 @@ pic_init_core(pic_state *pic)
     pic_init_attr(pic); DONE;
     pic_init_reg(pic); DONE;
 
+    VM3(CONS);
+    VM3(CAR);
+    VM3(CDR);
+    VM3(NILP);
+    VM3(SYMBOLP);
+    VM3(PAIRP);
+    VM3(NOT);
+    VM3(ADD);
+    VM3(SUB);
+    VM3(MUL);
+    VM3(DIV);
+    VM3(EQ);
+    VM3(LT);
+    VM3(LE);
+    VM3(GT);
+    VM3(GE);
+
     VM2(pic->pCONS, "cons");
     VM2(pic->pCAR, "car");
     VM2(pic->pCDR, "cdr");
@@ -420,6 +441,23 @@ pic_open(pic_allocf allocf, void *userdata)
   /* turn on GC */
   pic->gc_enable = true;
 
+  pic->cCONS = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cCAR = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cCDR = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cNILP = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cSYMBOLP = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cPAIRP = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cNOT = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cADD = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cSUB = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cMUL = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cDIV = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cEQ = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cLT = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cLE = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cGT = pic_cons(pic, pic_false_value(), pic_invalid_value());
+  pic->cGE = pic_cons(pic, pic_false_value(), pic_invalid_value());
+
   pic_init_core(pic);
 
   pic_gc_arena_restore(pic, ai);

extlib/benz/vm.c

@@ -389,6 +389,34 @@ pic_get_args(pic_state *pic, const char *format, ...)
   return argc;
 }
 
+pic_value
+pic_vm_gref_slot(pic_state *pic, pic_sym *uid)
+{
+  pic_value slot;
+
+  if (pic_dict_has(pic, pic->globals, uid)) {
+    return pic_dict_ref(pic, pic->globals, uid);
+  }
+  slot = pic_cons(pic, pic_obj_value(uid), pic_invalid_value());
+  pic_dict_set(pic, pic->globals, uid, slot);
+  return slot;
+}
+
+static pic_value
+vm_gref(pic_state *pic, pic_value slot)
+{
+  if (pic_invalid_p(pic_cdr(pic, slot))) {
+    pic_errorf(pic, "uninitialized global variable: ~a", pic_car(pic, slot));
+  }
+  return pic_cdr(pic, slot);
+}
+
+static void
+vm_gset(pic_state *pic, pic_value slot, pic_value value)
+{
+  pic_set_cdr(pic, slot, value);
+}
+
 static void
 vm_push_cxt(pic_state *pic)
 {
@@ -605,23 +633,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
       NEXT;
     }
     CASE(OP_GREF) {
-      pic_sym *sym;
-
-      sym = pic->ci->irep->syms[c.u.i];
-      if (! pic_dict_has(pic, pic->globals, sym)) {
-        pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, sym));
-      }
-      PUSH(pic_dict_ref(pic, pic->globals, sym));
+      PUSH(vm_gref(pic, pic->ci->irep->pool[c.u.i]));
       NEXT;
     }
     CASE(OP_GSET) {
-      pic_sym *sym;
-      pic_value val;
-
-      sym = pic->ci->irep->syms[c.u.i];
-
-      val = POP();
-      pic_dict_set(pic, pic->globals, sym, val);
+      vm_gset(pic, pic->ci->irep->pool[c.u.i], POP());
       PUSH(pic_undef_value());
       NEXT;
     }
@@ -840,7 +856,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
     }
 
 #define check_condition(name, n) do {                                   \
-      if (! pic_eq_p(pic->p##name, pic_dict_ref(pic, pic->globals, pic->u##name))) \
+      if (! pic_eq_p(pic->p##name, pic_cdr(pic, pic->c##name)))         \
         goto L_CALL;                                                    \
       if (c.u.i != n + 1)                                               \
         goto L_CALL;                                                    \
@@ -1106,7 +1122,7 @@ pic_define_(pic_state *pic, const char *name, pic_value val)
     }
   }
 
-  pic_dict_set(pic, pic->globals, uid, val);
+  pic_set(pic, pic->lib, name, val);
 }
 
 void
@@ -1153,7 +1169,7 @@ pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  return pic_dict_ref(pic, pic->globals, uid);
+  return vm_gref(pic, pic_vm_gref_slot(pic, uid));
 }
 
 void
@@ -1167,7 +1183,7 @@ pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val)
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  pic_dict_set(pic, pic->globals, uid, val);
+  vm_gset(pic, pic_vm_gref_slot(pic, uid), val);
 }
 
 pic_value