diff --git a/include/picconf.h b/include/picconf.h index 3a2e6887..e3c1388e 100644 --- a/include/picconf.h +++ b/include/picconf.h @@ -13,7 +13,7 @@ #define PIC_STACK_SIZE 1024 #define PIC_IREP_SIZE 256 #define PIC_GLOBALS_SIZE 1024 -#define PIC_SYM_TBL_SIZE 128 +#define PIC_SYM_POOL_SIZE 128 #define PIC_POOL_SIZE 1024 /* enable all debug flags */ diff --git a/include/picrin.h b/include/picrin.h index 832a0a83..555c86fb 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -27,13 +27,15 @@ typedef struct { pic_callinfo *ci; pic_callinfo *cibase, *ciend; - pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG; - pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; - pic_value sCONS, sCAR, sCDR, sNILP; - pic_value sADD, sSUB, sMUL, sDIV; - pic_value sEQ, sLT, sLE, sGT, sGE; + pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG; + pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; + pic_sym sCONS, sCAR, sCDR, sNILP; + pic_sym sADD, sSUB, sMUL, sDIV; + pic_sym sEQ, sLT, sLE, sGT, sGE; - struct sym_tbl *sym_tbl; + struct xhash *sym_tbl; + const char **sym_pool; + size_t slen, scapa; struct xhash *global_tbl; pic_value *globals; @@ -71,8 +73,11 @@ int pic_get_args(pic_state *, const char *, ...); void pic_defun(pic_state *, const char *, pic_func_t); bool pic_eq_p(pic_state *, pic_value, pic_value); +bool pic_eqv_p(pic_state *, pic_value, pic_value); +bool pic_equql_p(pic_state *, pic_value, pic_value); -pic_value pic_intern_cstr(pic_state *, const char *); +pic_sym pic_intern_cstr(pic_state *, const char *); +const char *pic_symbol_name(pic_state *, pic_sym); pic_value pic_str_new(pic_state *, const char *, size_t); pic_value pic_str_new_cstr(pic_state *, const char *); diff --git a/include/picrin/symbol.h b/include/picrin/symbol.h deleted file mode 100644 index a84a6e21..00000000 --- a/include/picrin/symbol.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef SYMBOL_H__ -#define SYMBOL_H__ - -struct sym_tbl { - pic_value tbl[PIC_SYM_TBL_SIZE]; - size_t size; -}; - -pic_value sym_tbl_get(struct sym_tbl *, const char *); - -#endif diff --git a/include/picrin/value.h b/include/picrin/value.h index 8474710b..08caa40f 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -1,6 +1,8 @@ #ifndef VALUE_H__ #define VALUE_H__ +typedef int pic_sym; + enum pic_vtype { PIC_VTYPE_NIL, PIC_VTYPE_TRUE, @@ -8,6 +10,7 @@ enum pic_vtype { PIC_VTYPE_UNDEF, PIC_VTYPE_FLOAT, PIC_VTYPE_INT, + PIC_VTYPE_SYMBOL, PIC_VTYPE_EOF, PIC_VTYPE_HEAP }; @@ -18,6 +21,7 @@ typedef struct { void *data; double f; int i; + pic_sym sym; } u; } pic_value; @@ -27,11 +31,11 @@ enum pic_tt { PIC_TT_BOOL, PIC_TT_FLOAT, PIC_TT_INT, + PIC_TT_SYMBOL, PIC_TT_EOF, PIC_TT_UNDEF, /* heap */ PIC_TT_PAIR, - PIC_TT_SYMBOL, PIC_TT_PROC, PIC_TT_PORT, PIC_TT_STRING, @@ -51,11 +55,6 @@ struct pic_pair { pic_value cdr; }; -struct pic_symbol { - PIC_OBJECT_HEADER - char *name; -}; - struct pic_string { PIC_OBJECT_HEADER char *str; @@ -67,7 +66,6 @@ struct pic_port; #define pic_obj_ptr(o) ((struct pic_object *)o.u.data) #define pic_pair_ptr(o) ((struct pic_pair *)o.u.data) -#define pic_symbol_ptr(o) ((struct pic_symbol *)o.u.data) #define pic_str_ptr(v) ((struct pic_string *)v.u.data) enum pic_tt pic_type(pic_value); @@ -80,9 +78,11 @@ pic_value pic_undef_value(); pic_value pic_obj_value(void *); pic_value pic_float_value(double); pic_value pic_int_value(int); +pic_value pic_symbol_value(pic_sym); #define pic_float(v) ((v).u.f) #define pic_int(v) ((v).u.i) +#define pic_sym(v) ((v).u.sym) #define pic_nil_p(v) ((v).type == PIC_VTYPE_NIL) #define pic_true_p(v) ((v).type == PIC_VTYPE_TRUE) @@ -90,8 +90,8 @@ pic_value pic_int_value(int); #define pic_undef_p(v) ((v).type == PIC_VTYPE_UNDEF) #define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT) #define pic_int_p(v) ((v).type == PIC_VTYPE_INT) +#define pic_symbol_p(v) ((v).type == PIC_VTYPE_SYMBOL) #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR) -#define pic_symbol_p(v) (pic_type(v) == PIC_TT_SYMBOL) #define pic_str_p(v) (pic_type(v) == PIC_TT_STRING) #endif diff --git a/src/bool.c b/src/bool.c index 889f70ce..ea71a61f 100644 --- a/src/bool.c +++ b/src/bool.c @@ -12,7 +12,7 @@ pic_eq_p(pic_state *pic, pic_value x, pic_value y) case PIC_TT_NIL: return true; case PIC_TT_SYMBOL: - return pic_symbol_ptr(x) == pic_symbol_ptr(y); + return pic_sym(x) == pic_sym(y); default: return false; } diff --git a/src/codegen.c b/src/codegen.c index 7a3567ff..d6f614a5 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -51,14 +51,14 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope) pic_value sym; sym = pic_car(pic, v); - xh_put(x, pic_symbol_ptr(sym)->name, i++); + xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i++); } if (pic_nil_p(v)) { /* pass */ } else if (pic_symbol_p(v)) { new_scope->varg = true; - xh_put(x, pic_symbol_ptr(v)->name, i); + xh_put(x, pic_symbol_name(pic, pic_sym(v)), i); } else { pic_error(pic, "logic flaw"); @@ -179,7 +179,7 @@ codegen(codegen_state *state, pic_value obj) int depth, idx; const char *name; - name = pic_symbol_ptr(obj)->name; + name = pic_symbol_name(pic, pic_sym(obj)); s = scope_lookup(state, name, &depth, &idx); if (! s) { pic_error(pic, "unbound variable"); @@ -213,256 +213,259 @@ codegen(codegen_state *state, pic_value obj) } proc = pic_car(pic, obj); - if (pic_eq_p(pic, proc, pic->sDEFINE)) { - int idx; - pic_value var, val; + if (pic_symbol_p(proc)) { + pic_sym sym = pic_sym(proc); - if (pic_length(pic, obj) < 3) { - pic_error(pic, "syntax error"); - } + if (sym == pic->sDEFINE) { + int idx; + pic_value var, val; - var = pic_car(pic, pic_cdr(pic, obj)); - if (pic_pair_p(var)) { - val = pic_cons(pic, pic->sLAMBDA, - pic_cons(pic, pic_cdr(pic, var), - pic_cdr(pic, pic_cdr(pic, obj)))); - var = pic_car(pic, var); - } - else { - if (pic_length(pic, obj) != 3) { + if (pic_length(pic, obj) < 3) { pic_error(pic, "syntax error"); } - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); - } - if (! pic_symbol_p(var)) { - pic_error(pic, "syntax error"); - } - idx = scope_global_define(pic, pic_symbol_ptr(var)->name); + var = pic_car(pic, pic_cdr(pic, obj)); + if (pic_pair_p(var)) { + val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA), + pic_cons(pic, pic_cdr(pic, var), + pic_cdr(pic, pic_cdr(pic, obj)))); + var = pic_car(pic, var); + } + else { + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + } + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } - codegen(state, val); - irep->code[irep->clen].insn = OP_GSET; - irep->code[irep->clen].u.i = idx; - irep->clen++; - irep->code[irep->clen].insn = OP_PUSHFALSE; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sLAMBDA)) { - int k = pic->ilen++; - irep->code[irep->clen].insn = OP_LAMBDA; - irep->code[irep->clen].u.i = k; - irep->clen++; + idx = scope_global_define(pic, pic_symbol_name(pic, pic_sym(var))); - pic->irep[k] = codegen_lambda(state, obj); - break; - } - else if (pic_eq_p(pic, proc, pic->sIF)) { - int s,t; - - if (pic_length(pic, obj) != 4) { - pic_error(pic, "syntax error"); - } - - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - - irep->code[irep->clen].insn = OP_JMPIF; - s = irep->clen++; - - /* if false branch */ - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj))))); - irep->code[irep->clen].insn = OP_JMP; - t = irep->clen++; - - irep->code[s].u.i = irep->clen - s; - - /* if true branch */ - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[t].u.i = irep->clen - t; - break; - } - else if (pic_eq_p(pic, proc, pic->sBEGIN)) { - pic_value v, seq; - - seq = pic_cdr(pic, obj); - for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) { - codegen(state, pic_car(pic, v)); - irep->code[irep->clen].insn = OP_POP; - irep->clen++; - } - irep->clen--; - break; - } - else if (pic_eq_p(pic, proc, pic->sSETBANG)) { - codegen_scope *s; - pic_value var; - int depth, idx; - - if (pic_length(pic, obj) != 3) { - pic_error(pic, "syntax error"); - } - - var = pic_car(pic, pic_cdr(pic, obj)); - if (! pic_symbol_p(var)) { - pic_error(pic, "syntax error"); - } - - s = scope_lookup(state, pic_symbol_ptr(var)->name, &depth, &idx); - if (! s) { - pic_error(pic, "unbound variable"); - } - - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - - switch (depth) { - case -1: /* global */ + codegen(state, val); irep->code[irep->clen].insn = OP_GSET; irep->code[irep->clen].u.i = idx; irep->clen++; + irep->code[irep->clen].insn = OP_PUSHFALSE; + irep->clen++; break; - default: /* nonlocal */ - /* dirty flag */ - s->cv_tbl[idx] = 1; - /* at this stage, lset and cset are not distinguished */ - FALLTHROUGH; - case 0: /* local */ - irep->code[irep->clen].insn = OP_CSET; - irep->code[irep->clen].u.c.depth = depth; - irep->code[irep->clen].u.c.idx = idx; + } + else if (sym == pic->sLAMBDA) { + int k = pic->ilen++; + irep->code[irep->clen].insn = OP_LAMBDA; + irep->code[irep->clen].u.i = k; + irep->clen++; + + pic->irep[k] = codegen_lambda(state, obj); + break; + } + else if (sym == pic->sIF) { + int s,t; + + if (pic_length(pic, obj) != 4) { + pic_error(pic, "syntax error"); + } + + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + + irep->code[irep->clen].insn = OP_JMPIF; + s = irep->clen++; + + /* if false branch */ + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj))))); + irep->code[irep->clen].insn = OP_JMP; + t = irep->clen++; + + irep->code[s].u.i = irep->clen - s; + + /* if true branch */ + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[t].u.i = irep->clen - t; + break; + } + else if (sym == pic->sBEGIN) { + pic_value v, seq; + + seq = pic_cdr(pic, obj); + for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) { + codegen(state, pic_car(pic, v)); + irep->code[irep->clen].insn = OP_POP; + irep->clen++; + } + irep->clen--; + break; + } + else if (sym == pic->sSETBANG) { + codegen_scope *s; + pic_value var; + int depth, idx; + + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + + var = pic_car(pic, pic_cdr(pic, obj)); + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } + + s = scope_lookup(state, pic_symbol_name(pic, pic_sym(var)), &depth, &idx); + if (! s) { + pic_error(pic, "unbound variable"); + } + + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + + switch (depth) { + case -1: /* global */ + irep->code[irep->clen].insn = OP_GSET; + irep->code[irep->clen].u.i = idx; + irep->clen++; + break; + default: /* nonlocal */ + /* dirty flag */ + s->cv_tbl[idx] = 1; + /* at this stage, lset and cset are not distinguished */ + FALLTHROUGH; + case 0: /* local */ + irep->code[irep->clen].insn = OP_CSET; + irep->code[irep->clen].u.c.depth = depth; + irep->code[irep->clen].u.c.idx = idx; + irep->clen++; + break; + } + + irep->code[irep->clen].insn = OP_PUSHFALSE; + irep->clen++; + break; + } + else if (sym == pic->sQUOTE) { + int pidx; + + if (pic_length(pic, obj) != 2) { + pic_error(pic, "syntax error"); + } + + pidx = pic->plen++; + pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); + irep->code[irep->clen].insn = OP_PUSHCONST; + irep->code[irep->clen].u.i = pidx; irep->clen++; break; } - irep->code[irep->clen].insn = OP_PUSHFALSE; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sQUOTE)) { - int pidx; - - if (pic_length(pic, obj) != 2) { - pic_error(pic, "syntax error"); - } - - pidx = pic->plen++; - pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); - irep->code[irep->clen].insn = OP_PUSHCONST; - irep->code[irep->clen].u.i = pidx; - irep->clen++; - break; - } - #define ARGC_ASSERT(n) do { \ - if (pic_length(pic, obj) != (n) + 1) { \ - pic_error(pic, "wrong number of arguments"); \ - } \ - } while (0) + if (pic_length(pic, obj) != (n) + 1) { \ + pic_error(pic, "wrong number of arguments"); \ + } \ + } while (0) - else if (pic_eq_p(pic, proc, pic->sCONS)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_CONS; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sCAR)) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - irep->code[irep->clen].insn = OP_CAR; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sCDR)) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - irep->code[irep->clen].insn = OP_CDR; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sNILP)) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - irep->code[irep->clen].insn = OP_NILP; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sADD)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_ADD; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sSUB)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_SUB; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sMUL)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_MUL; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sDIV)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_DIV; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sEQ)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_EQ; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sLT)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_LT; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sLE)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_LE; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sGT)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - irep->code[irep->clen].insn = OP_LT; - irep->clen++; - break; - } - else if (pic_eq_p(pic, proc, pic->sGE)) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - codegen(state, pic_car(pic, pic_cdr(pic, obj))); - irep->code[irep->clen].insn = OP_LE; - irep->clen++; - break; - } - else { - codegen_call(state, obj); - break; + else if (sym == pic->sCONS) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_CONS; + irep->clen++; + break; + } + else if (sym == pic->sCAR) { + ARGC_ASSERT(1); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + irep->code[irep->clen].insn = OP_CAR; + irep->clen++; + break; + } + else if (sym == pic->sCDR) { + ARGC_ASSERT(1); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + irep->code[irep->clen].insn = OP_CDR; + irep->clen++; + break; + } + else if (sym == pic->sNILP) { + ARGC_ASSERT(1); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + irep->code[irep->clen].insn = OP_NILP; + irep->clen++; + break; + } + else if (sym == pic->sADD) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_ADD; + irep->clen++; + break; + } + else if (sym == pic->sSUB) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_SUB; + irep->clen++; + break; + } + else if (sym == pic->sMUL) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_MUL; + irep->clen++; + break; + } + else if (sym == pic->sDIV) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_DIV; + irep->clen++; + break; + } + else if (sym == pic->sEQ) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_EQ; + irep->clen++; + break; + } + else if (sym == pic->sLT) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_LT; + irep->clen++; + break; + } + else if (sym == pic->sLE) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + irep->code[irep->clen].insn = OP_LE; + irep->clen++; + break; + } + else if (sym == pic->sGT) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + irep->code[irep->clen].insn = OP_LT; + irep->clen++; + break; + } + else if (sym == pic->sGE) { + ARGC_ASSERT(2); + codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + codegen(state, pic_car(pic, pic_cdr(pic, obj))); + irep->code[irep->clen].insn = OP_LE; + irep->clen++; + break; + } } + + codegen_call(state, obj); + break; } case PIC_TT_BOOL: { if (pic_true_p(obj)) { diff --git a/src/gc.c b/src/gc.c index d3b5ce43..40776471 100644 --- a/src/gc.c +++ b/src/gc.c @@ -4,7 +4,6 @@ #include "picrin/gc.h" #include "picrin/irep.h" #include "picrin/proc.h" -#include "picrin/symbol.h" #include "picrin/port.h" #if GC_DEBUG @@ -156,9 +155,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) gc_mark(pic, ((struct pic_pair *)obj)->cdr); break; } - case PIC_TT_SYMBOL: { - break; - } case PIC_TT_ENV: { struct pic_env *env = (struct pic_env *)obj; int i; @@ -186,6 +182,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) case PIC_TT_BOOL: case PIC_TT_FLOAT: case PIC_TT_INT: + case PIC_TT_SYMBOL: case PIC_TT_EOF: case PIC_TT_UNDEF: pic_abort(pic, "logic flaw"); @@ -214,7 +211,6 @@ gc_mark_phase(pic_state *pic) for (stack = pic->stbase; stack != pic->sp; ++stack) { gc_mark(pic, *stack); } - gc_mark(pic, *stack); /* arena */ for (i = 0; i < pic->arena_idx; ++i) { @@ -230,34 +226,6 @@ gc_mark_phase(pic_state *pic) for (i = 0; i < pic->plen; ++i) { gc_mark(pic, pic->pool[i]); } - - /* symbol table */ - for (i = 0; i < pic->sym_tbl->size; ++i) { - gc_mark(pic, pic->sym_tbl->tbl[i]); - } - - gc_mark(pic, pic->sDEFINE); - gc_mark(pic, pic->sLAMBDA); - gc_mark(pic, pic->sIF); - gc_mark(pic, pic->sBEGIN); - gc_mark(pic, pic->sSETBANG); - gc_mark(pic, pic->sQUOTE); - gc_mark(pic, pic->sQUASIQUOTE); - gc_mark(pic, pic->sUNQUOTE); - gc_mark(pic, pic->sUNQUOTE_SPLICING); - gc_mark(pic, pic->sCONS); - gc_mark(pic, pic->sCAR); - gc_mark(pic, pic->sCDR); - gc_mark(pic, pic->sNILP); - gc_mark(pic, pic->sADD); - gc_mark(pic, pic->sSUB); - gc_mark(pic, pic->sMUL); - gc_mark(pic, pic->sEQ); - gc_mark(pic, pic->sLT); - gc_mark(pic, pic->sLE); - gc_mark(pic, pic->sGT); - gc_mark(pic, pic->sGE); - gc_mark(pic, pic->sDIV); } static bool @@ -280,12 +248,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) #endif switch (obj->tt) { - case PIC_TT_SYMBOL: { - char *name; - name = ((struct pic_symbol *)obj)->name; - pic_free(pic, name); - break; - } case PIC_TT_PAIR: { break; } @@ -311,6 +273,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) case PIC_TT_BOOL: case PIC_TT_FLOAT: case PIC_TT_INT: + case PIC_TT_SYMBOL: case PIC_TT_EOF: case PIC_TT_UNDEF: pic_abort(pic, "logic flaw"); diff --git a/src/parse.y b/src/parse.y index 83cc9bd0..52baa02a 100644 --- a/src/parse.y +++ b/src/parse.y @@ -58,7 +58,7 @@ program } /* if multiple? */ else { - p->value = pic_cons(p->pic, p->pic->sBEGIN, $1); + p->value = pic_cons(p->pic, pic_symbol_value(p->pic->sBEGIN), $1); } } | incomplete_program_data @@ -92,7 +92,7 @@ datum simple_datum : tSYMBOL { - $$ = pic_intern_cstr(p->pic, $1); + $$ = pic_symbol_value(pic_intern_cstr(p->pic, $1)); free($1); } | tSTRING diff --git a/src/port.c b/src/port.c index b44ee312..debc8018 100644 --- a/src/port.c +++ b/src/port.c @@ -27,7 +27,7 @@ write(pic_state *pic, pic_value obj) printf(")"); break; case PIC_TT_SYMBOL: - printf("%s", pic_symbol_ptr(obj)->name); + printf("%s", pic_symbol_name(pic, pic_sym(obj))); break; case PIC_TT_FLOAT: printf("%f", pic_float(obj)); diff --git a/src/state.c b/src/state.c index f72ea5d3..e040ccde 100644 --- a/src/state.c +++ b/src/state.c @@ -3,24 +3,8 @@ #include "picrin.h" #include "picrin/gc.h" #include "picrin/proc.h" -#include "picrin/symbol.h" #include "xhash/xhash.h" -struct sym_tbl * -sym_tbl_new() -{ - struct sym_tbl *s_tbl; - int i; - - s_tbl = (struct sym_tbl *)malloc(sizeof(struct sym_tbl)); - s_tbl->size = PIC_SYM_TBL_SIZE; - - for (i = 0; i < PIC_SYM_TBL_SIZE; ++i) { - s_tbl->tbl[i] = pic_nil_value(); - } - return s_tbl; -} - void pic_init_core(pic_state *); pic_state * @@ -49,7 +33,10 @@ pic_open(int argc, char *argv[], char **envp) init_heap_page(pic->heap); /* symbol table */ - pic->sym_tbl = sym_tbl_new(); + pic->sym_tbl = xh_new(); + pic->sym_pool = (const char **)malloc(sizeof(const char *) * PIC_SYM_POOL_SIZE); + pic->slen = 0; + pic->scapa = pic->slen + PIC_SYM_POOL_SIZE; /* irep */ pic->irep = (struct pic_irep **)malloc(sizeof(struct pic_irep *) * PIC_IREP_SIZE); diff --git a/src/symbol.c b/src/symbol.c index f9d67a54..e6d98b13 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -2,65 +2,27 @@ #include #include "picrin.h" -#include "picrin/pair.h" -#include "picrin/symbol.h" +#include "xhash/xhash.h" -static int -str_hash(const char *str) -{ - int hash = 0, len, i; - - len = strlen(str); - for (i = 0; i < len; ++i) { - hash = hash * 31 + str[i]; - } - return hash; -} - -pic_value -sym_tbl_get(struct sym_tbl *s_tbl, const char *key) -{ - int hash, idx; - pic_value v, k; - char *name; - - hash = str_hash(key); - idx = hash % s_tbl->size; - for (v = s_tbl->tbl[idx]; ! pic_nil_p(v); v = pic_pair_ptr(v)->cdr) { - k = pic_pair_ptr(v)->car; - - name = pic_symbol_ptr(k)->name; - if (strcmp(name, key) == 0) { - return k; - } - } - return pic_undef_value(); -} - -pic_value +pic_sym pic_intern_cstr(pic_state *pic, const char *str) { - pic_value v; - int len, hash, idx; - char *new_str; - struct pic_symbol *sym; + struct xh_entry *e; + pic_sym id; - v = sym_tbl_get(pic->sym_tbl, str); - if (! pic_undef_p(v)) { - return v; + e = xh_get(pic->sym_tbl, str); + if (e) { + return e->val; } - /* clone name string */ - len = strlen(str); - new_str = (char *)pic_alloc(pic, len + 1); - strncpy(new_str, str, len + 1); - - sym = (struct pic_symbol*)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL); - sym->name = new_str; - v = pic_obj_value(sym); - - hash = str_hash(str); - idx = hash % pic->sym_tbl->size; - pic->sym_tbl->tbl[idx] = pic_cons(pic, v, pic->sym_tbl->tbl[idx]); - return v; + id = pic->slen++; + pic->sym_pool[id] = strdup(str); + xh_put(pic->sym_tbl, str, id); + return id; +} + +const char * +pic_symbol_name(pic_state *pic, pic_sym sym) +{ + return pic->sym_pool[sym]; } diff --git a/src/value.c b/src/value.c index ad6e741d..8aaa60d2 100644 --- a/src/value.c +++ b/src/value.c @@ -19,6 +19,8 @@ pic_type(pic_value v) return PIC_TT_FLOAT; case PIC_VTYPE_INT: return PIC_TT_INT; + case PIC_VTYPE_SYMBOL: + return PIC_TT_SYMBOL; case PIC_VTYPE_EOF: return PIC_TT_EOF; case PIC_VTYPE_HEAP: @@ -98,6 +100,16 @@ pic_int_value(int i) return v; } +pic_value +pic_symbol_value(pic_sym sym) +{ + pic_value v; + + v.type = PIC_VTYPE_SYMBOL; + v.u.sym = sym; + return v; +} + pic_value pic_undef_value() {