Merge pull request #4 from Hojun-Cho/compact

raise heap memory

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){

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;

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);
 }

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;
 }

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);

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;
 }

main.c

@@ -3,7 +3,8 @@
 #include <setjmp.h>
 #include <stdio.h>
 
-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("<env>");
+		SExprint(obj->vars);
 		break;
 	case OLAMBDA:
 		printf("<lambda>");
@@ -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();
 }

makefile

@@ -10,7 +10,7 @@ OFILES=\
 	parser.o
 
 AS=$(CC) -c
-CFLAGS=-c  -g -O0
+CFLAGS=-c  -g -O2 -Wall -std=c99
 
 all: $(NAME)
 

obj.c

@@ -4,26 +4,26 @@
 #include <string.h>
 
 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; 
 }

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*

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;