diff --git a/bltin.c b/bltin.c index 4e2fb93..0ae2104 100644 --- a/bltin.c +++ b/bltin.c @@ -42,7 +42,7 @@ bltinlookup(Object *obj) {&Quote ,0}, {&Car ,0}, {&Cdr ,0}, - 0, + {0}, }; for(int i = 0; bltins[i].sym; ++i){ diff --git a/dat.h b/dat.h index d2920bf..9deb8cf 100644 --- a/dat.h +++ b/dat.h @@ -3,7 +3,6 @@ typedef uintptr_t u64; typedef struct Object Object; typedef Object* (*Bltinfn)(Object *env, Object *args); -typedef struct Object Object; enum OType { @@ -24,6 +23,7 @@ struct Object enum OType type; /* type */ int flag; /* flag */ Object *next; /* for gc */ + Object *forward; union{ /* int */ long num; @@ -60,6 +60,7 @@ struct Object */ typedef struct { + int running; void *memory; u64 cap; u64 using; @@ -79,6 +80,7 @@ typedef struct }; }GC; +extern GC *gc; extern Object Nil; extern Object True; extern Object False; diff --git a/error.c b/error.c index f5ccf88..48b8bf0 100644 --- a/error.c +++ b/error.c @@ -19,7 +19,7 @@ panic(char *fmt, ...) void error(char *fmt, ...) { - extern jmp_buf err; + extern jmp_buf *errptr; va_list ap; va_start(ap, fmt); @@ -27,6 +27,6 @@ error(char *fmt, ...) vfprintf(stderr, fmt, ap); va_end(ap); fprintf(stderr, "\n"); - longjmp(err, 1); + longjmp(*errptr, 1); exit(1); } diff --git a/eval.c b/eval.c index fceea69..a47c0d8 100644 --- a/eval.c +++ b/eval.c @@ -40,9 +40,9 @@ enter(Object *env, Object *vars, Object *args) error("Cna't apply function argment dose not match"); Object *id = vars->car; Object *val = args->car; - map = newacons(id, val, map); + map = newacons(gc, id, val, map); } - return newenv(&Nil, map, env); + return newenv(gc, &Nil, map, env); } Object* @@ -56,7 +56,7 @@ fnlambda(Object *env, Object *l) } Object *params = l->car; Object *body = l->cdr; - return newfn(env, params, body); + return newfn(gc, env, params, body); } Object* @@ -79,7 +79,8 @@ fndefine(Object *env, Object *list) Object *obj = find(env, list->car); if(obj) return obj->cdr = val; - return env->vars = newacons(list->car, val, env->vars); + env->vars = newacons(gc, list->car, val, env->vars); + return env->vars; } Object* @@ -91,7 +92,7 @@ fnplus(Object *env, Object *list) error("+ take only number"); sum += p->car->num; } - return newint(sum); + return newint(gc, sum); } static Object* @@ -103,7 +104,7 @@ evallist(Object *env, Object *list) error("type is not list"); Object *car = eval(env, list->car); Object *cdr = evallist(env, list->cdr); - return newcons(car, cdr); + return newcons(gc, car, cdr); } static Object* @@ -124,27 +125,29 @@ apply(Object *env, Object *fn, Object *args) if(islist(args) == 0) error("args is not list type"); switch(fn->type){ - case OBLTIN: - Bltinfn blt = bltinlookup(fn); - if(blt==0) - error("not builtin type!"); - return blt(env, args); + default: error("can't apply"); + case OBLTIN:{ + Bltinfn blt = bltinlookup(fn); + if(blt==0) + error("not builtin type!"); + return blt(env, args); + } case OFUNC:{ Object *elist = evallist(env, args); Object*res = applyfn(fn, elist); return res; } } - error("can't apply"); - return 0; } Object* eval(Object *env, Object *obj) { switch(obj->type){ - case OINT: + default: + error("can't eval"); case OSTRING: + case OINT: case OBLTIN: case OSYMBOL: return obj; @@ -162,6 +165,4 @@ eval(Object *env, Object *obj) return res; } } - error("can't apply"); - return 0; } diff --git a/fn.h b/fn.h index b5c9263..76746cf 100644 --- a/fn.h +++ b/fn.h @@ -7,21 +7,20 @@ Object* eval(Object *env, Object *expr); /* new */ -Object* newint(long); -Object* newcons(Object*,Object*); -Object* newenv(Object*name, Object *vars, Object *up); -Object* newacons(Object*, Object*, Object*); -Object* newsymbol(char*, int); -Object* newstr(int); -Object* newfn(Object *env, Object *params, Object *body); +Object* newint(GC *,long); +Object* newcons(GC *,Object*,Object*); +Object* newenv(GC *,Object*name, Object *vars, Object *up); +Object* newacons(GC *,Object*, Object*, Object*); +Object* newsymbol(GC *,char*, int); +Object* newstr(GC *,int); +Object* newfn(GC *,Object *env, Object *params, Object *body); /* gc.c */ -void gcstatus(void); -Object* newobj(enum OType); -void* gcalloc(int); -void* gcralloc(void*, int); -void gcinit(void *top, int cap); -void gcrun(void); +Object* newobj(GC *,enum OType); +void* gcalloc(GC *,int); +void* gcralloc(GC *, void*, int); +GC* newgc(void *top, int cap); +void gcrun(GC *); /* str.c */ void strputc(Object*, int); diff --git a/gc.c b/gc.c index cb12e9c..bc3a796 100644 --- a/gc.c +++ b/gc.c @@ -8,56 +8,160 @@ enum { USING = 1 << 1, + FORWARD = 1 << 2, OFFSET = sizeof(int), }; -GC gc = {0}; +Object* +cloneobj(GC *dst, GC *src, Object *obj) +{ + if(obj == 0) + return 0; + if(obj->type==OBLTIN||obj->type==OSYMBOL) + return obj; + if(obj->flag&FORWARD) + return obj->forward; + Object *p = newobj(dst, obj->type); + obj->flag |= FORWARD; + obj->forward = p; + switch(obj->type){ + default: panic("unreachable"); + case OINT: + p->num = obj->num; + break; + case OSTRING: + case OIDENT:{ + int len = obj->ptr - obj->beg; + p->beg = gcalloc(dst, len + 1); + p->end = p->ptr = p->beg + len; + memcpy(p->beg, obj->beg, len + 1); + break; + } + case OCELL: + p->car = cloneobj(dst, src, obj->car); + p->cdr = cloneobj(dst, src, obj->cdr); + break; + case OENV: + p->name = cloneobj(dst, src, obj->name); + p->vars = cloneobj(dst, src, obj->vars); + p->up = cloneobj(dst, src, obj->up); + break; + case OFUNC: + p->params = cloneobj(dst, src, obj->params); + p->body = cloneobj(dst, src, obj->body); + p->env = cloneobj(dst, src, obj->env); + break; + } + return p; +} + +Object* +moveobj(Object *p) +{ + if(p == 0 || p->type == 0) + return 0; + switch(p->type){ + default: + return p->forward; + case OBLTIN: + case OSYMBOL: + return p; + } +} void -gcfree(void *src) +forwardstack(u64 bot, GC *dst, GC *src) +{ + u64 pos, diff, *stk; + Object *moved, *org; + for(; bot < src->top; bot += sizeof(bot)){ + stk = (u64*)(void**)bot; + if(src->ob <= *stk && *stk < src->oe){ + diff = (*stk - src->ob) % sizeof(Object); + org = (Object*)(*stk - diff); + if((moved = moveobj(org)) == 0) + continue; + diff = (u64)org - *stk; + pos = (u64)moved + diff; + memcpy(stk, &pos, sizeof(pos)); + } + else if(src->sb <= *stk && *stk < src->se) + for(org = src->objs; org; org = org->next){ + if(org->type == OSTRING || org->type == OIDENT){ + u64 beg = (u64)org->beg - OFFSET; + u64 end = beg + *(int*)beg; + if(beg <= *stk && *stk < end){ + moved = moveobj(org); + diff = (*stk - beg); + pos = (u64)moved->beg - OFFSET + diff; + memcpy(stk, &pos, sizeof(pos)); + break; + } + } + } + } +} + +void +gccompact(int cap, GC *src) +{ + void *_ = 0; + u64 bot = (u64)&_; + GC *dst = newgc((void*)src->top, cap); + dst->running = 1; + for(Object *p=src->objs; p; p=p->next) + cloneobj(dst, src, p); + forwardstack(bot, dst, src); + free(src->memory); + *src = *dst; + free(dst); +} + +void +gcfree(GC *gc, void *src) { int *p = (int*)src - 1; int sz = *p; memset(p, 0, sz); - gc.using -= sz; + gc->using -= sz; } void -freeobj(Object *p) +freeobj(GC *gc, Object *p) { - gc.using -= sizeof(Object); + gc->using -= sizeof(Object); p->next = 0; switch(p->type){ default: break; case OSTRING: case OIDENT: - gcfree(p->beg); + gcfree(gc, p->beg); break; } memset(p, 0, sizeof(Object)); - if(gc.freed == 0) - gc.freed = p; + if(gc->freed == 0) + gc->freed = p; else{ - p->next = gc.freed; - gc.freed = p; + p->next = gc->freed; + gc->freed = p; } } void* -gcalloc(int sz) +gcalloc(GC *gc, int sz) { sz += OFFSET; if(sz % OFFSET) sz = sz + OFFSET - (sz % OFFSET); - for(u64 i = gc.sb; i < gc.se;){ + for(u64 i = gc->sb; i < gc->se;){ u64 j = i; for(;j - i < sz; j += OFFSET){ if(*(int*)(j) != 0) break; } if(j - i == sz){ - gc.using += sz; + gc->using += sz; *(int*)i = sz; i += OFFSET; return (void*)i; @@ -65,135 +169,149 @@ gcalloc(int sz) i = j + *(int*)(j); } panic("gccalloc : Not impl yet raise"); + return 0; } void* -gcralloc(void *src, int sz) +gcralloc(GC *gc, void *src, int sz) { - void *dst = gcalloc(sz); + void *dst = gcalloc(gc, sz); int osz = ((int*)src)[-1]; memcpy(dst, src, osz); - gcfree(src); + gcfree(gc, src); return dst; } void -mark(Object *obj) +mark(GC *gc, Object *obj) { - if(obj == 0 || obj->flag&USING) + if(obj == 0 || obj->flag&USING || + obj->type == 0|| obj->type==OBLTIN ||obj->type==OSYMBOL) return; obj->flag = USING; switch(obj->type){ + default:break; case OCELL: - mark(obj->car); - mark(obj->cdr); + mark(gc, obj->car); + mark(gc, obj->cdr); break; case OENV: - mark(obj->name); - mark(obj->vars); - mark(obj->up); + mark(gc, obj->name); + mark(gc, obj->vars); + mark(gc, obj->up); break; case OFUNC: - mark(obj->params); - mark(obj->body); - mark(obj->env); + mark(gc, obj->params); + mark(gc, obj->body); + mark(gc, obj->env); break; } } void -gcsweep(void) +gcsweep(GC *gc) { Object *last = 0; - for(Object *p = gc.objs; p;){ + for(Object *p = gc->objs; p;){ + if(p->type == 0|| p->type==OBLTIN ||p->type==OSYMBOL) + return; if(p->flag&USING){ - p->flag = 0; + p->flag &= ~(USING); last = p; p = p->next; }else{ Object *tmp = p; if(last == 0){ - gc.objs = p->next; + gc->objs = p->next; }else{ last->next = p->next; } p = p->next; - freeobj(tmp); + freeobj(gc, tmp); } } } -int -isobj(u64 p) -{ - if(gc.ob <= p && p < gc.oe){ - p -= gc.ob; - return (p % sizeof(Object)) == 0; - } - return 0; -} - void -gcmark(void) +gcmark(GC *gc) { - void *_ = 0; + u64 _ = 0, stk, diff; u64 bot = (u64)&_; - for(; bot < gc.top; bot += sizeof(bot)){ - u64 val = (u64)*(void**)bot; - if(isobj(val)) - mark((Object*)val); + Object *obj; + for(; bot < gc->top; bot += sizeof(bot)){ + stk = (u64)*(void**)bot; + if(gc->ob <= stk && stk <= gc->oe){ + diff = (stk - gc->ob) % sizeof(Object); + obj = (Object*)(stk - diff); + mark(gc, obj); + } + else if(gc->sb <= stk && stk <= gc->se) + for(Object *obj = gc->objs; obj; obj = obj->next) + if(obj->type == OSTRING || obj->type == OIDENT){ + u64 beg = (u64)obj->beg - OFFSET; + u64 end = beg + *(int*)beg; + if(beg <= stk && stk < end){ + mark(gc, obj); + break; + } + } } } void -gcrun(void) +gcrun(GC *src) { - printf("before=> cap:%d using:%d remain:%d\n", gc.cap, gc.using, gc.cap-gc.using); + if(src->running) + return; + printf("BEFORE=> cap:%10ld using:%10ld remain:%10ld\n", src->cap, src->using, src->cap - src->using); + src->running = 1; jmp_buf reg; - setjmp(reg); - gcmark(); - gcsweep(); - printf("after=> cap:%d using:%d remain:%d\n", gc.cap, gc.using, gc.cap-gc.using); + if(setjmp(reg)==1){ + printf("AFTER => cap:%10ld using:%10ld remain:%10ld\n", src->cap, src->using, src->cap - src->using); + src->running = 0; + return; + } + gcmark(src); + gcsweep(src); + gccompact(src->cap + 500, src); + longjmp(reg, 1); } Object* -newobj(enum OType type) -{ - if(gc.op + sizeof(Object) >= gc.oe){ - panic("Not impl yet newobj raise"); - } - gcrun(); - gc.using += sizeof(Object); +newobj(GC *gc, enum OType type) +{ + gcrun(gc); + gc->using += sizeof(Object); Object *r = 0; - if(gc.freed){ - r = gc.freed; - gc.freed = gc.freed->next; + if(gc->freed){ + r = gc->freed; + gc->freed = gc->freed->next; }else{ - r = (Object*)gc.op; - gc.op += sizeof(Object); + r = (Object*)gc->op; + gc->op += sizeof(Object); } r->type = type; - if(gc.objs == 0) - gc.objs = r; - else{ - r->next = gc.objs; - gc.objs = r; - } - return r; + if(gc->objs) + r->next = gc->objs; + return gc->objs = r; } -void -gcinit(void *top, int cap) +GC* +newgc(void *top, int cap) { - gc.top = (u64)top; - if((gc.memory = malloc(cap)) == 0) + GC *gc = calloc(1, sizeof(GC)); + if(gc == 0) + panic("can't alloc %d byte\n", sizeof(GC)); + gc->top = (u64)top; + if((gc->memory = calloc(1, cap)) == 0) panic("can't alloc %d byte\n", cap); - gc.cap = cap; - gc.using = 0; + gc->cap = cap; + gc->using = 0; - gc.op = gc.ob = (u64)gc.memory; - gc.oe = gc.op + (float)cap * 0.64; + gc->op = gc->ob = (u64)gc->memory; + gc->oe = gc->op + (float)cap * 0.64; - gc.sb = (u64)gc.memory + (float)cap * 0.64; - gc.se = (u64)gc.memory + cap; + gc->sb = (u64)gc->memory + (float)cap * 0.64; + gc->se = (u64)gc->memory + cap; + return gc; } diff --git a/main.c b/main.c index 05f7f28..377cfa5 100644 --- a/main.c +++ b/main.c @@ -3,7 +3,8 @@ #include #include -jmp_buf err; +jmp_buf *errptr; +GC *gc; static void SExprint(Object *obj) @@ -11,6 +12,8 @@ SExprint(Object *obj) if(obj == 0) return; switch(obj->type){ + default: + return; case OCELL: printf("("); SExprint(obj->car); @@ -33,6 +36,7 @@ SExprint(Object *obj) break; case OENV: printf(""); + SExprint(obj->vars); break; case OLAMBDA: printf(""); @@ -58,21 +62,26 @@ printexpr(Object *obj) static void loop(void) { - Object *root = newenv(&Nil, &Nil, &Nil); - if(setjmp(err) == 1){ + Object *env = newenv(gc, &Nil, &Nil, &Nil); + jmp_buf buf; + errptr = &buf; + if(setjmp(buf) == 1){ skipline(); - gcrun(); } while(1){ Object *res = nextexpr(); - res = eval(root, res); + res = eval(env, res); + printf("=============res===========\n"); printexpr(res); + printf("=============env===========\n"); + printexpr(env); + printf("===========================\n"); } } int main(int argc, char *argv[]) { - gcinit(&argc, 4000); + gc = newgc(&argc, 4000); loop(); } diff --git a/makefile b/makefile index 174b7a7..d59439e 100644 --- a/makefile +++ b/makefile @@ -10,7 +10,7 @@ OFILES=\ parser.o AS=$(CC) -c -CFLAGS=-c -g -O0 +CFLAGS=-c -g -O2 -Wall -std=c99 all: $(NAME) diff --git a/obj.c b/obj.c index ee24769..d13a061 100644 --- a/obj.c +++ b/obj.c @@ -4,26 +4,26 @@ #include Object* -newint(long val) +newint(GC *gc, long val) { - Object *obj = newobj(OINT); + Object *obj = newobj(gc, OINT); obj->num = val; return obj; } Object* -newcons(Object *car, Object *cdr) +newcons(GC *gc, Object *car, Object *cdr) { - Object *obj = newobj(OCELL); + Object *obj = newobj(gc, OCELL); obj->car = car; obj->cdr = cdr; return obj; } Object* -newenv(Object* name, Object *vars, Object *up) +newenv(GC *gc, Object* name, Object *vars, Object *up) { - Object *obj = newobj(OENV); + Object *obj = newobj(gc, OENV); obj->name = name; obj->up = up; obj->vars = vars; @@ -31,16 +31,16 @@ newenv(Object* name, Object *vars, Object *up) } Object* -newacons(Object *x, Object *y, Object *z) +newacons(GC *gc, Object *x, Object *y, Object *z) { - Object *cons = newcons(x, y); - return newcons(cons, z); + Object *cons = newcons(gc, x, y); + return newcons(gc, cons ,z); } Object* -newfn(Object *env, Object *params, Object *body) +newfn(GC *gc, Object *env, Object *params, Object *body) { - Object *fn = newobj(OFUNC); + Object *fn = newobj(gc, OFUNC); fn->params = params; fn->body = body; fn->env = env; @@ -48,7 +48,7 @@ newfn(Object *env, Object *params, Object *body) } Object* -newsymbol(char *str, int len) +newsymbol(GC *gc, char *str, int len) { static Object *syms[] = { &Nil, &True, &False, &Minus, &Plus, @@ -59,18 +59,18 @@ newsymbol(char *str, int len) if(strlen(c->sym)==len && memcmp(c->sym, str, len) == 0) return c; } - Object *obj = newobj(OIDENT); - obj->beg = gcalloc(len + 1); + Object *obj = newobj(gc, OIDENT); + obj->beg = gcalloc(gc, len + 1); obj->end = obj->ptr = obj->beg + len; memcpy(obj->beg, str, len+1); return obj; } Object* -newstr(int len) +newstr(GC *gc, int len) { - Object *obj = newobj(OSTRING); - obj->ptr = obj->beg = gcalloc(len + 1); + Object *obj = newobj(gc, OSTRING); + obj->ptr = obj->beg = gcalloc(gc, len + 1); obj->end = obj->beg + len; return obj; } diff --git a/parser.c b/parser.c index 8c347f3..bc09b53 100644 --- a/parser.c +++ b/parser.c @@ -62,7 +62,7 @@ symbol(char c) buf[len++] = get(); } buf[len] = 0; - return newsymbol(buf, len); + return newsymbol(gc, buf, len); } static long @@ -79,14 +79,14 @@ quote(void) { Object *car = &Quote; Object *ccdr = list(); - Object *cdr = newcons(ccdr, &Nil); - return newcons(car, cdr); + Object *cdr = newcons(gc, ccdr, &Nil); + return newcons(gc, car, cdr); } static Object* string(void) { - Object *str = newstr(16); + Object *str = newstr(gc, 16); while(lookup() != '\"'){ strputc(str, get()); } @@ -98,11 +98,11 @@ static Object* atom(char c) { if(isdigit(c)) - return newint(number()); + return newint(gc, number()); get(); if(c == '-'){ if(isdigit(lookup())) - return newint(-number()); + return newint(gc, -number()); else return symbol('-'); } @@ -113,6 +113,7 @@ atom(char c) return symbol(c); } error("bad char in list '%c'", c); + return 0; } static Object* @@ -126,20 +127,20 @@ lparlist(void) get(); car = quote(); cdr = lparlist(); - return newcons(car, cdr); + return newcons(gc, car, cdr); case '.': get(); return list(); case '(': car = list(); cdr = lparlist(); - return newcons(car, cdr); + return newcons(gc, car, cdr); case ')': return &Nil; } car = atom(c); cdr = lparlist(); - return newcons(car ,cdr); + return newcons(gc, car ,cdr); } static Object* diff --git a/str.c b/str.c index adcb595..4dea718 100644 --- a/str.c +++ b/str.c @@ -6,7 +6,7 @@ void strraise(Object *s, int ns) { int pos = s->ptr - s->beg; - char *ptr = gcralloc(s->beg, ns + 1); + char *ptr = gcralloc(gc, s->beg, ns + 1); s->beg = ptr; s->ptr = s->beg + pos; s->end = s->beg + ns;