conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'update-xhash'

This commit is contained in:
Yuichi Nishiwaki 2014-03-25 15:30:16 +09:00
parent 794c87b870 ca42b44921
commit 3d1aaf8ec3
12 changed files with 99 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extlib/xhash

@ -1 +1 @@
Subproject commit ad806edfb100b4fd78a64dd079051f80a9f9336c
Subproject commit 985d9af6188a1426788e56db03025847c32e519b

8
include/picrin.h
View File

@ -86,16 +86,16 @@ typedef struct {
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
xhash *syms; /* name to symbol */
xhash *sym_names; /* symbol to name */
xhash syms; /* name to symbol */
xhash sym_names; /* symbol to name */
int sym_cnt;
int uniq_sym_cnt;
xhash *global_tbl;
xhash global_tbl;
pic_value *globals;
size_t glen, gcapa;
xhash *macros;
xhash macros;
pic_value lib_tbl;
struct pic_lib *lib;

2
include/picrin/lib.h
View File

@ -13,7 +13,7 @@ struct pic_lib {
PIC_OBJECT_HEADER
pic_value name;
struct pic_senv *senv;
xhash *exports;
xhash exports;
};
#define pic_lib_ptr(o) ((struct pic_lib *)pic_ptr(o))

2
include/picrin/macro.h
View File

@ -11,7 +11,7 @@ extern "C" {
struct pic_senv {
PIC_OBJECT_HEADER
xhash *renames;
xhash renames;
struct pic_senv *up;
};

28
src/codegen.c
View File

@ -61,7 +61,6 @@ static analyze_state *
new_analyze_state(pic_state *pic)
{
analyze_state *state;
xhash *global_tbl;
xh_iter it;
struct pic_lib *stdlib;
@ -101,9 +100,10 @@ new_analyze_state(pic_state *pic)
/* push initial scope */
push_scope(state, pic_nil_value());
global_tbl = pic->global_tbl;
for (xh_begin(global_tbl, &it); ! xh_isend(&it); xh_next(&it)) {
xv_push(&state->scope->locals, &it.e->key);
xh_begin(&it, &pic->global_tbl);
while (xh_next(&it)) {
pic_sym sym = xh_key(it.e, pic_sym);
xv_push(&state->scope->locals, &sym);
}
return state;
@ -294,15 +294,15 @@ analyze_global_var(analyze_state *state, pic_sym sym)
xh_entry *e;
size_t i;
if ((e = xh_get_int(pic->global_tbl, sym))) {
i = e->val;
if ((e = xh_get(&pic->global_tbl, sym))) {
i = xh_val(e, size_t);
}
else {
i = pic->glen++;
if (i >= pic->gcapa) {
pic_error(pic, "global table overflow");
}
xh_put_int(pic->global_tbl, sym, i);
xh_put(&pic->global_tbl, sym, &i);
}
return pic_list2(pic, pic_symbol_value(state->sGREF), pic_int_value(i));
}
@ -894,26 +894,28 @@ static void
create_activation(codegen_context *cxt)
{
size_t i, n;
xhash *regs;
xhash regs;
pic_sym *var;
size_t offset;
regs = xh_new_int();
xh_init_int(&regs, sizeof(size_t));
offset = 1;
for (i = 0; i < cxt->args.size; ++i) {
var = xv_get(&cxt->args, i);
xh_put_int(regs, *var, i + offset);
n = i + offset;
xh_put(&regs, *var, &n);
}
offset += i;
for (i = 0; i < cxt->locals.size; ++i) {
var = xv_get(&cxt->locals, i);
xh_put_int(regs, *var, i + offset);
n = i + offset;
xh_put(&regs, *var, &n);
}
for (i = 0; i < cxt->captures.size; ++i) {
var = xv_get(&cxt->captures, i);
if ((n = xh_get_int(regs, *var)->val) <= cxt->args.size) {
if ((n = xh_val(xh_get(&regs, *var), size_t)) <= cxt->args.size) {
/* copy arguments to capture variable area */
cxt->code[cxt->clen].insn = OP_LREF;
cxt->code[cxt->clen].u.i = n;
@ -925,7 +927,7 @@ create_activation(codegen_context *cxt)
}
}
xh_destroy(regs);
xh_destroy(&regs);
}
static void

9
src/gc.c
View File

@ -549,8 +549,9 @@ gc_mark_phase(pic_state *pic)
}
/* macro objects */
for (xh_begin(pic->macros, &it); ! xh_isend(&it); xh_next(&it)) {
gc_mark_object(pic, (struct pic_object *)it.e->val);
xh_begin(&it, &pic->macros);
while (xh_next(&it)) {
gc_mark_object(pic, xh_val(it.e, struct pic_object *));
}
/* library table */
@ -604,7 +605,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_SENV: {
struct pic_senv *senv = (struct pic_senv *)obj;
xh_destroy(senv->renames);
xh_destroy(&senv->renames);
break;
}
case PIC_TT_MACRO: {
@ -615,7 +616,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_LIB: {
struct pic_lib *lib = (struct pic_lib *)obj;
xh_destroy(lib->exports);
xh_destroy(&lib->exports);
break;
}
case PIC_TT_VAR: {

2
src/lib.c
View File

@ -28,8 +28,8 @@ pic_make_library(pic_state *pic, pic_value name)
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
lib->senv = senv;
lib->exports = xh_new_int();
lib->name = name;
xh_init_int(&lib->exports, sizeof(pic_sym));
/* register! */
pic->lib_tbl = pic_acons(pic, name, pic_obj_value(lib), pic->lib_tbl);

37
src/macro.c
View File

@ -25,7 +25,7 @@ pic_put_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym renam
{
UNUSED(pic);
xh_put_int(senv->renames, sym, rename);
xh_put(&senv->renames, sym, &rename);
}
pic_sym
@ -35,10 +35,10 @@ pic_find_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
UNUSED(pic);
if ((e = xh_get_int(senv->renames, sym)) == NULL) {
if ((e = xh_get(&senv->renames, sym)) == NULL) {
return 0;
}
return e->val;
return xh_val(e, pic_sym);
}
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
@ -51,7 +51,7 @@ senv_new(pic_state *pic, struct pic_senv *up)
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = up;
senv->renames = xh_new_int();
xh_init_int(&senv->renames, sizeof(pic_sym));
return senv;
}
@ -144,16 +144,14 @@ pic_import(pic_state *pic, pic_value spec)
if (! lib) {
pic_error(pic, "library not found");
}
for (xh_begin(lib->exports, &it); ! xh_isend(&it); xh_next(&it)) {
xh_begin(&it, &lib->exports);
while (xh_next(&it)) {
#if DEBUG
assert(it.e->val >= 0);
printf("* importing %s as %s\n",
pic_symbol_name(pic, (long)it.e->key),
pic_symbol_name(pic, it.e->val));
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
#endif
pic_put_rename(pic, pic->lib->senv, (long)it.e->key, it.e->val);
pic_put_rename(pic, pic->lib->senv, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
}
}
@ -166,7 +164,12 @@ pic_export(pic_state *pic, pic_sym sym)
if (rename == 0) {
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
}
xh_put_int(pic->lib->exports, sym, rename);
#if DEBUG
printf("* exporting %s as %s\n", pic_symbol_name(pic, sym), pic_symbol_name(pic, rename));
#endif
xh_put(&pic->lib->exports, sym, &rename);
}
void
@ -181,7 +184,7 @@ pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
/* symbol registration */
sym = pic_intern_cstr(pic, name);
rename = pic_add_rename(pic, pic->lib->senv, sym);
xh_put_int(pic->macros, rename, (long)mac);
xh_put(&pic->macros, rename, &mac);
/* auto export! */
pic_export(pic, sym);
@ -319,7 +322,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
}
mac = macro_new(pic, pic_proc_ptr(v), senv);
xh_put_int(pic->macros, rename, (long)mac);
xh_put(&pic->macros, rename, &mac);
pic_gc_arena_restore(pic, ai);
return pic_none_value();
@ -367,7 +370,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
}
mac = macro_new(pic, pic_proc_ptr(v), NULL);
xh_put_int(pic->macros, rename, (long)mac);
xh_put(&pic->macros, rename, &mac);
pic_gc_arena_restore(pic, ai);
return pic_none_value();
@ -456,7 +459,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
}
/* macro */
if ((e = xh_get_int(pic->macros, tag)) != NULL) {
if ((e = xh_get(&pic->macros, tag)) != NULL) {
pic_value v, args;
struct pic_macro *mac;
@ -466,7 +469,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
puts("");
#endif
mac = (struct pic_macro *)e->val;
mac = xh_val(e, struct pic_macro *);
if (mac->senv == NULL) { /* legacy macro */
args = pic_cdr(pic, expr);
}
@ -590,7 +593,7 @@ pic_null_syntactic_env(pic_state *pic)
#define register_core_syntax(pic,senv,id) do { \
pic_sym sym = pic_intern_cstr(pic, id); \
pic_put_rename(pic, senv, sym, sym); \
pic_put_rename(pic, senv, sym, sym); \
} while (0)
struct pic_senv *

27
src/state.c
View File

@ -46,19 +46,19 @@ pic_open(int argc, char *argv[], char **envp)
pic->heap = pic_heap_open();
/* symbol table */
pic->syms = xh_new_str();
pic->sym_names = xh_new_int();
xh_init_str(&pic->syms, sizeof(pic_sym));
xh_init_int(&pic->sym_names, sizeof(const char *));
pic->sym_cnt = 0;
pic->uniq_sym_cnt = 0;
/* global variables */
pic->global_tbl = xh_new_int();
xh_init_int(&pic->global_tbl, sizeof(size_t));
pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
pic->glen = 0;
pic->gcapa = PIC_GLOBALS_SIZE;
/* macros */
pic->macros = xh_new_int();
xh_init_int(&pic->macros, sizeof(struct pic_macro *));
/* libraries */
pic->lib_tbl = pic_nil_value();
@ -76,7 +76,7 @@ pic_open(int argc, char *argv[], char **envp)
pic->native_stack_start = &t;
/* symbol 0 is reserved for system */
xh_put_int(pic->sym_names, pic->sym_cnt++, (long)"<system-reserved-symbol>");
xh_put(&pic->sym_names, pic->sym_cnt++, &"<system-reserved-symbol>");
#define register_core_symbol(pic,slot,name) do { \
pic->slot = pic_intern_cstr(pic, name); \
@ -137,7 +137,7 @@ pic_close(pic_state *pic)
pic->arena_idx = 0;
pic->err = NULL;
pic->glen = 0;
xh_clear(pic->macros);
xh_clear(&pic->macros);
pic->lib_tbl = pic_nil_value();
/* free all heap objects */
@ -152,17 +152,18 @@ pic_close(pic_state *pic)
/* free global stacks */
free(pic->globals);
xh_destroy(pic->syms);
xh_destroy(pic->global_tbl);
xh_destroy(pic->macros);
xh_destroy(&pic->syms);
xh_destroy(&pic->global_tbl);
xh_destroy(&pic->macros);
/* free symbol names */
for (xh_begin(pic->sym_names, &it); ! xh_isend(&it); xh_next(&it)) {
if (it.e->key == 0)
xh_begin(&it, &pic->sym_names);
while (xh_next(&it)) {
if (xh_key(it.e, pic_sym) == 0)
continue;
free((void *)it.e->val);
free(xh_val(it.e, char *));
}
free(pic->sym_names);
xh_destroy(&pic->sym_names);
free(pic);
}

12
src/symbol.c
View File

@ -20,14 +20,14 @@ pic_intern(pic_state *pic, const char *str, size_t len)
cstr[len] = '\0';
memcpy(cstr, str, len);
e = xh_get(pic->syms, cstr);
e = xh_get(&pic->syms, cstr);
if (e) {
return e->val;
return xh_val(e, pic_sym);
}
id = pic->sym_cnt++;
xh_put(pic->syms, cstr, id);
xh_put_int(pic->sym_names, id, (long)cstr);
xh_put(&pic->syms, cstr, &id);
xh_put(&pic->sym_names, id, &cstr);
return id;
}
@ -50,7 +50,7 @@ pic_gensym(pic_state *pic, pic_sym base)
/* don't put the symbol to pic->syms to keep it uninterned */
uniq = pic->sym_cnt++;
xh_put_int(pic->sym_names, uniq, (long)str);
xh_put(&pic->sym_names, uniq, &str);
return uniq;
}
@ -64,7 +64,7 @@ pic_interned_p(pic_state *pic, pic_sym sym)
const char *
pic_symbol_name(pic_state *pic, pic_sym sym)
{
return (const char *)xh_get_int(pic->sym_names, sym)->val;
return xh_val(xh_get(&pic->sym_names, sym), const char *);
}
static pic_value

6
src/vm.c
View File

@ -339,10 +339,10 @@ global_ref(pic_state *pic, const char *name)
if ((rename = pic_find_rename(pic, pic->lib->senv, sym)) == 0) {
return SIZE_MAX;
}
if (! (e = xh_get_int(pic->global_tbl, rename))) {
if (! (e = xh_get(&pic->global_tbl, rename))) {
return SIZE_MAX;
}
return e->val;
return xh_val(e, size_t);
}
static size_t
@ -365,7 +365,7 @@ global_def(pic_state *pic, const char *name)
if (pic->glen >= pic->gcapa) {
pic_error(pic, "global table overflow");
}
xh_put_int(pic->global_tbl, rename, gidx);
xh_put(&pic->global_tbl, rename, &gidx);
return gidx;
}

49
src/write.c
View File

@ -46,8 +46,8 @@ struct writer_control {
pic_state *pic;
xFILE *file;
int mode;
xhash *labels;
xhash *visited;
xhash labels; /* object -> int */
xhash visited; /* object -> int */
int cnt;
};
@ -63,9 +63,9 @@ writer_control_new(pic_state *pic, xFILE *file, int mode)
p->pic = pic;
p->file = file;
p->mode = mode;
p->labels = xh_new_ptr();
p->visited = xh_new_ptr();
p->cnt = 0;
xh_init_ptr(&p->labels, sizeof(int));
xh_init_ptr(&p->visited, sizeof(int));
return p;
}
@ -74,8 +74,8 @@ writer_control_destroy(struct writer_control *p)
{
pic_state *pic = p->pic;
xh_destroy(p->labels);
xh_destroy(p->visited);
xh_destroy(&p->labels);
xh_destroy(&p->visited);
pic_free(pic, p);
}
@ -84,16 +84,19 @@ traverse_shared(struct writer_control *p, pic_value obj)
{
xh_entry *e;
size_t i;
int c;
switch (pic_type(obj)) {
case PIC_TT_PAIR:
case PIC_TT_VECTOR:
e = xh_get(p->labels, pic_obj_ptr(obj));
e = xh_get(&p->labels, pic_obj_ptr(obj));
if (e == NULL) {
xh_put(p->labels, pic_obj_ptr(obj), -1);
c = -1;
xh_put(&p->labels, pic_obj_ptr(obj), &c);
}
else if (e->val == -1) {
xh_put(p->labels, pic_obj_ptr(obj), p->cnt++);
else if (xh_val(e, int) == -1) {
c = p->cnt++;
xh_put(&p->labels, pic_obj_ptr(obj), &c);
break;
}
else {
@ -122,6 +125,7 @@ static void
write_pair(struct writer_control *p, struct pic_pair *pair)
{
xh_entry *e;
int c;
write_core(p, pair->car);
@ -131,16 +135,17 @@ write_pair(struct writer_control *p, struct pic_pair *pair)
else if (pic_pair_p(pair->cdr)) {
/* shared objects */
if ((e = xh_get(p->labels, pic_obj_ptr(pair->cdr))) && e->val != -1) {
if ((e = xh_get(&p->labels, pic_obj_ptr(pair->cdr))) && xh_val(e, int) != -1) {
xfprintf(p->file, " . ");
if ((xh_get(p->visited, pic_obj_ptr(pair->cdr)))) {
xfprintf(p->file, "#%d#", e->val);
if ((xh_get(&p->visited, pic_obj_ptr(pair->cdr)))) {
xfprintf(p->file, "#%d#", xh_val(e, int));
return;
}
else {
xfprintf(p->file, "#%d=", e->val);
xh_put(p->visited, pic_obj_ptr(pair->cdr), 1);
xfprintf(p->file, "#%d=", xh_val(e, int));
c = 1;
xh_put(&p->visited, pic_obj_ptr(pair->cdr), &c);
}
}
else {
@ -179,18 +184,20 @@ write_core(struct writer_control *p, pic_value obj)
xFILE *file = p->file;
size_t i;
xh_entry *e;
int c;
/* shared objects */
if (pic_vtype(obj) == PIC_VTYPE_HEAP
&& (e = xh_get(p->labels, pic_obj_ptr(obj)))
&& e->val != -1) {
if ((xh_get(p->visited, pic_obj_ptr(obj)))) {
xfprintf(file, "#%d#", e->val);
&& (e = xh_get(&p->labels, pic_obj_ptr(obj)))
&& xh_val(e, int) != -1) {
if ((xh_get(&p->visited, pic_obj_ptr(obj)))) {
xfprintf(file, "#%d#", xh_val(e, int));
return;
}
else {
xfprintf(file, "#%d=", e->val);
xh_put(p->visited, pic_obj_ptr(obj), 1);
xfprintf(file, "#%d=", xh_val(e, int));
c = 1;
xh_put(&p->visited, pic_obj_ptr(obj), &c);
}
}