diff --git a/Makefile b/Makefile index cd42edba..1602b6b0 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ build-lib: cd src; \ yacc -d parse.y; \ lex scan.l - $(CC) -Wall -shared -o lib/libpicrin.so -I./include src/*.c + $(CC) -Wall -shared -o lib/libpicrin.so -I./include -I./extlib src/*.c clean: rm -f src/y.tab.c src/y.tab.h src/lex.yy.c diff --git a/extlib/xhash/xhash.h b/extlib/xhash/xhash.h new file mode 100644 index 00000000..4cf70ae6 --- /dev/null +++ b/extlib/xhash/xhash.h @@ -0,0 +1,104 @@ +#ifndef XHASH_H__ +#define XHASH_H__ + +/* + * Copyright (c) 2013 by Yuichi Nishiwaki + */ + +#include +#include + +/* simple string to int hash table */ + +#define XHASH_INIT_SIZE 11 + +struct xh_entry { + struct xh_entry *next; + const char *key; + int val; +}; + +struct xhash { + struct xh_entry **buckets; + size_t size; +}; + +static inline struct xhash * +xh_new() +{ + struct xhash *x; + + x = (struct xhash *)malloc(sizeof(struct xhash)); + x->size = XHASH_INIT_SIZE; + x->buckets = (struct xh_entry **)calloc(XHASH_INIT_SIZE, sizeof(struct xh_entry *)); + return x; +} + +static int +xh_hash(const char *str) +{ + int hash = 0; + + while (*str) { + hash = hash * 31 + *str++; + } + return hash; +} + +static inline struct xh_entry * +xh_get(struct xhash *x, const char *key) +{ + int idx; + struct xh_entry *e; + + idx = xh_hash(key) % x->size; + for (e = x->buckets[idx]; e; e = e->next) { + if (! strcmp(key, e->key)) + return e; + } + return NULL; +} + +static inline struct xh_entry * +xh_put(struct xhash *x, const char *key, int val) +{ + int idx, len; + char *new_key; + struct xh_entry *e; + + if ((e = xh_get(x, key))) { + e->val = val; + return e; + } + + len = strlen(key); + new_key = (char *)malloc(len+1); + strcpy(new_key, key); + + idx = xh_hash(key) % x->size; + e = (struct xh_entry *)malloc(sizeof(struct xh_entry)); + e->next = x->buckets[idx]; + e->key = new_key; + e->val = val; + + return x->buckets[idx] = e; +} + +static inline void +xh_destory(struct xhash *x) +{ + int i; + struct xh_entry *e; + + for (i = 0; i < x->size; ++i) { + e = x->buckets[i]; + while (e) { + e = e->next; + free((void*)e->key); + free(e); + } + } + free(x); +} + +#endif diff --git a/include/picrin.h b/include/picrin.h index 626e3503..f5b908d0 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -29,12 +29,13 @@ typedef struct { pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE; pic_value sCONS, sCAR, sCDR, sNILP; pic_value sADD, sSUB, sMUL, sDIV; - struct pic_env *global_env; struct sym_tbl *sym_tbl; + struct xhash *global_tbl; pic_value *globals; size_t glen, gcapa; + struct pic_irep **irep; size_t ilen, icapa; pic_value *pool; @@ -74,9 +75,8 @@ pic_value pic_str_new_cstr(pic_state *, const char *); bool pic_parse(pic_state *, const char *, pic_value *); -pic_value pic_eval(pic_state *, pic_value, struct pic_env *); pic_value pic_run(pic_state *, struct pic_proc *, pic_value); -struct pic_proc *pic_codegen(pic_state *, pic_value, struct pic_env *); +struct pic_proc *pic_codegen(pic_state *, pic_value); void pic_abort(pic_state *, const char *); void pic_raise(pic_state *, pic_value); diff --git a/include/picrin/proc.h b/include/picrin/proc.h index 776d1ac4..e598b949 100644 --- a/include/picrin/proc.h +++ b/include/picrin/proc.h @@ -1,11 +1,6 @@ #ifndef PROC_H__ #define PROC_H__ -struct pic_env { - pic_value assoc; - struct pic_env *parent; -}; - struct pic_proc { PIC_OBJECT_HEADER bool cfunc_p; diff --git a/src/codegen.c b/src/codegen.c index 4079fb41..7241183a 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -4,28 +4,81 @@ #include "picrin/pair.h" #include "picrin/irep.h" #include "picrin/proc.h" +#include "xhash/xhash.h" + +struct pic_scope { + struct pic_scope *up; + + struct xhash *local_tbl; + size_t localc; +}; + +static struct pic_scope * +new_global_scope(pic_state *pic) +{ + struct pic_scope *scope; + + scope = (struct pic_scope *)pic_alloc(pic, sizeof(struct pic_scope)); + scope->up = NULL; + scope->local_tbl = pic->global_tbl; + scope->localc = -1; + return scope; +} + +static struct pic_scope * +new_local_scope(pic_state *pic, pic_value args, struct pic_scope *scope) +{ + struct pic_scope *new_scope; + pic_value v; + int i; + struct xhash *x; + + new_scope = (struct pic_scope *)pic_alloc(pic, sizeof(struct pic_scope)); + new_scope->up = scope; + new_scope->local_tbl = x = xh_new(); + + i = -1; + for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) { + pic_value sym; + + sym = pic_car(pic, v); + xh_put(x, pic_symbol_ptr(sym)->name, i--); + } + new_scope->localc = -1-i; + + return new_scope; +} + +static void +destory_scope(pic_state *pic, struct pic_scope *scope) +{ + if (scope->up) { + xh_destory(scope->local_tbl); + } + pic_free(pic, scope); +} static bool -env_lookup(pic_state *pic, pic_value sym, struct pic_env *env, int *depth, int *idx) +scope_lookup(pic_state *pic, const char *key, struct pic_scope *scope, int *depth, int *idx) { - pic_value v; + struct xh_entry *e; int d = 0; enter: - v = pic_assq(pic, sym, env->assoc); - if (! pic_nil_p(v)) { - if (env->parent == NULL) { /* global */ + e = xh_get(scope->local_tbl, key); + if (e) { + if (scope->up == NULL) { /* global */ *depth = -1; } else { /* non-global */ *depth = d; } - *idx = (int)pic_float(pic_pair_ptr(v)->cdr); + *idx = e->val; return true; } - if (env->parent) { - env = env->parent; + if (scope->up) { + scope = scope->up; ++d; goto enter; } @@ -33,42 +86,18 @@ env_lookup(pic_state *pic, pic_value sym, struct pic_env *env, int *depth, int * } static int -env_global_define(pic_state *pic, pic_value sym) +scope_global_define(pic_state *pic, const char *name) { - pic_value f; - int d, idx; + struct xh_entry *e; - if (env_lookup(pic, sym, pic->global_env, &d, &idx)) { - return idx; + if ((e = xh_get(pic->global_tbl, name))) { + return e->val; } - - idx = pic->glen++; - f = pic_float_value(idx); - pic->global_env->assoc = pic_acons(pic, sym, f, pic->global_env->assoc); - - return idx; -} - -static struct pic_env * -env_new(pic_state *pic, pic_value args, struct pic_env *env) -{ - struct pic_env *inner_env; - pic_value v, f; - int i; - - inner_env = (struct pic_env *)pic_alloc(pic, sizeof(struct pic_env)); - inner_env->assoc = pic_nil_value(); - inner_env->parent = env; - - i = -1; - for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) { - pic_value sym = pic_car(pic, v); - - f = pic_float_value(i--); - inner_env->assoc = pic_acons(pic, sym, f, inner_env->assoc); + e = xh_put(pic->global_tbl, name, pic->glen++); + if (pic->glen >= pic->gcapa) { + pic_error(pic, "global table overflow"); } - - return inner_env; + return e->val; } void @@ -78,7 +107,7 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc) int idx; proc = pic_proc_new_cfunc(pic, cfunc, pic_undef_value()); - idx = env_global_define(pic, pic_intern_cstr(pic, name)); + idx = scope_global_define(pic, name); pic->globals[idx] = pic_obj_value(proc); } @@ -177,11 +206,11 @@ new_irep(pic_state *pic) return irep; } -static void pic_gen_call(pic_state *, struct pic_irep *, pic_value, struct pic_env *); -static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *); +static void pic_gen_call(pic_state *, struct pic_irep *, pic_value, struct pic_scope *); +static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_scope *); static void -pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) +pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_scope *scope) { pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE; pic_value sCONS, sCAR, sCDR, sNILP; @@ -205,8 +234,10 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en case PIC_TT_SYMBOL: { bool b; int depth, idx; + const char *name; - b = env_lookup(pic, obj, env, &depth, &idx); + name = pic_symbol_ptr(obj)->name; + b = scope_lookup(pic, name, scope, &depth, &idx); if (! b) { pic_error(pic, "unbound variable"); } @@ -232,10 +263,12 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en proc = pic_car(pic, obj); if (pic_eq_p(pic, proc, sDEFINE)) { int idx; + const char *name; - idx = env_global_define(pic, pic_car(pic, pic_cdr(pic, obj))); + name = pic_symbol_ptr(pic_car(pic, pic_cdr(pic, obj)))->name; + idx = scope_global_define(pic, name); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[irep->clen].insn = OP_GSET; irep->code[irep->clen].u.i = idx; @@ -249,26 +282,26 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en irep->code[irep->clen].u.i = pic->ilen; irep->clen++; - pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, env); + pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, scope); break; } else if (pic_eq_p(pic, proc, sIF)) { int s,t; - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_JMPIF; s = irep->clen++; /* if false branch */ - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))), scope); irep->code[irep->clen].insn = OP_JMP; t = irep->clen++; irep->code[s].u.i = irep->clen - s; /* if true branch */ - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); irep->code[t].u.i = irep->clen - t; break; } @@ -277,7 +310,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en seq = pic_cdr(pic, obj); for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) { - pic_gen(pic, irep, pic_car(pic, v), env); + pic_gen(pic, irep, pic_car(pic, v), scope); irep->code[irep->clen].insn = OP_POP; irep->clen++; } @@ -294,60 +327,60 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en break; } else if (pic_eq_p(pic, proc, sCONS)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_CONS; irep->clen++; break; } else if (pic_eq_p(pic, proc, sCAR)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_CAR; irep->clen++; break; } else if (pic_eq_p(pic, proc, sCDR)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_CDR; irep->clen++; break; } else if (pic_eq_p(pic, proc, sNILP)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_NILP; irep->clen++; break; } else if (pic_eq_p(pic, proc, sADD)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_ADD; irep->clen++; break; } else if (pic_eq_p(pic, proc, sSUB)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_SUB; irep->clen++; break; } else if (pic_eq_p(pic, proc, sMUL)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_MUL; irep->clen++; break; } else if (pic_eq_p(pic, proc, sDIV)) { - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); - pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope); + pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope); irep->code[irep->clen].insn = OP_DIV; irep->clen++; break; } else { - pic_gen_call(pic, irep, obj, env); + pic_gen_call(pic, irep, obj, scope); break; } } @@ -391,7 +424,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en } static void -pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) +pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_scope *scope) { pic_value seq; int i = 0; @@ -401,7 +434,7 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_en pic_value v; v = pic_car(pic, seq); - pic_gen(pic, irep, v, env); + pic_gen(pic, irep, v, scope); ++i; } irep->code[irep->clen].insn = OP_CALL; @@ -410,9 +443,9 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_en } static struct pic_irep * -pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env) +pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_scope *scope) { - struct pic_env *inner_env; + struct pic_scope *new_scope; pic_value args, body, v; struct pic_irep *irep; @@ -420,19 +453,20 @@ pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env) /* arguments */ args = pic_car(pic, pic_cdr(pic, obj)); - inner_env = env_new(pic, args, env); + new_scope = new_local_scope(pic, args, scope); /* body */ body = pic_cdr(pic, pic_cdr(pic, obj)); for (v = body; ! pic_nil_p(v); v = pic_cdr(pic, v)) { - pic_gen(pic, irep, pic_car(pic, v), inner_env); + pic_gen(pic, irep, pic_car(pic, v), scope); irep->code[irep->clen].insn = OP_POP; irep->clen++; } irep->clen--; irep->code[irep->clen].insn = OP_RET; irep->clen++; - pic_free(pic, inner_env); + + destory_scope(pic, new_scope); #if VM_DEBUG printf("LAMBDA_%zd:\n", pic->ilen); @@ -444,11 +478,14 @@ pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env) } struct pic_proc * -pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env) +pic_codegen(pic_state *pic, pic_value obj) { + struct pic_scope *global_scope; struct pic_proc *proc; struct pic_irep *irep; + global_scope = new_global_scope(pic); + irep = new_irep(pic); proc = pic_proc_new(pic, irep); @@ -464,10 +501,12 @@ pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env) return NULL; } } - pic_gen(pic, irep, obj, env); + pic_gen(pic, irep, obj, global_scope); irep->code[irep->clen].insn = OP_STOP; irep->clen++; + destory_scope(pic, global_scope); + #if VM_DEBUG print_irep(pic, irep); #endif diff --git a/src/gc.c b/src/gc.c index c834c096..4be5686c 100644 --- a/src/gc.c +++ b/src/gc.c @@ -181,7 +181,6 @@ static void gc_mark_phase(pic_state *pic) { pic_value *stack; - struct pic_env *env; int i; /* stack */ @@ -195,12 +194,6 @@ gc_mark_phase(pic_state *pic) gc_mark_object(pic, pic->arena[i]); } - /* global env */ - env = pic->global_env; - do { - gc_mark(pic, env->assoc); - } while ((env = env->parent) != NULL); - /* globals */ for (i = 0; i < pic->glen; ++i) { gc_mark(pic, pic->globals[i]); diff --git a/src/state.c b/src/state.c index 5cebdac9..f0f90a70 100644 --- a/src/state.c +++ b/src/state.c @@ -4,18 +4,7 @@ #include "picrin/gc.h" #include "picrin/proc.h" #include "picrin/symbol.h" - -static struct pic_env * -new_empty_env() -{ - struct pic_env *env; - - env = (struct pic_env *)malloc(sizeof(struct pic_env)); - env->assoc = pic_nil_value(); - env->parent = NULL; - - return env; -} +#include "xhash/xhash.h" struct sym_tbl * sym_tbl_new() @@ -68,6 +57,7 @@ pic_open(int argc, char *argv[], char **envp) pic->icapa = PIC_IREP_SIZE; /* globals */ + pic->global_tbl = xh_new(); pic->globals = (pic_value *)malloc(sizeof(pic_value) * PIC_GLOBALS_SIZE); pic->glen = 0; pic->gcapa = PIC_GLOBALS_SIZE; @@ -84,10 +74,6 @@ pic_open(int argc, char *argv[], char **envp) /* GC arena */ pic->arena_idx = 0; - /* global environment */ - pic->global_env = new_empty_env(); - pic_init_core(pic); - ai = pic_gc_arena_preserve(pic); pic->sDEFINE = pic_intern_cstr(pic, "define"); pic->sLAMBDA = pic_intern_cstr(pic, "lambda"); @@ -104,6 +90,8 @@ pic_open(int argc, char *argv[], char **envp) pic->sDIV = pic_intern_cstr(pic, "/"); pic_gc_arena_restore(pic, ai); + pic_init_core(pic); + return pic; } diff --git a/tools/main.c b/tools/main.c index 275e01dd..f5484550 100644 --- a/tools/main.c +++ b/tools/main.c @@ -80,7 +80,7 @@ main(int argc, char *argv[], char **envp) #endif /* eval */ - proc = pic_codegen(pic, v, pic->global_env); + proc = pic_codegen(pic, v); if (proc == NULL) { printf("compilation error: %s\n", pic->errmsg); pic->errmsg = NULL;