diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c index 77f3a97b..51df8c0c 100644 --- a/extlib/benz/codegen.c +++ b/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) { diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 7608fbcf..878c500e 100644 --- a/extlib/benz/gc.c +++ b/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 diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 91bb31db..f543aeeb 100644 --- a/extlib/benz/include/picrin.h +++ b/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) } diff --git a/extlib/benz/include/picrin/box.h b/extlib/benz/include/picrin/box.h new file mode 100644 index 00000000..edce0f0d --- /dev/null +++ b/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 diff --git a/extlib/benz/include/picrin/irep.h b/extlib/benz/include/picrin/irep.h index 327fb32c..bcaf4eb6 100644 --- a/extlib/benz/include/picrin/irep.h +++ b/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; }; diff --git a/extlib/benz/include/picrin/value.h b/extlib/benz/include/picrin/value.h index 09e63151..e055430f 100644 --- a/extlib/benz/include/picrin/value.h +++ b/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"; } diff --git a/extlib/benz/state.c b/extlib/benz/state.c index e29c4304..2fb447a3 100644 --- a/extlib/benz/state.c +++ b/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); diff --git a/extlib/benz/vm.c b/extlib/benz/vm.c index 5e2217c6..ec63da8b 100644 --- a/extlib/benz/vm.c +++ b/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