now can move object
overwirte stack value to new object address
This commit is contained in:
parent
c1c9614744
commit
5989b46e69
2
bltin.c
2
bltin.c
@ -42,7 +42,7 @@ bltinlookup(Object *obj)
|
|||||||
{&Quote ,0},
|
{&Quote ,0},
|
||||||
{&Car ,0},
|
{&Car ,0},
|
||||||
{&Cdr ,0},
|
{&Cdr ,0},
|
||||||
0,
|
{0},
|
||||||
};
|
};
|
||||||
|
|
||||||
for(int i = 0; bltins[i].sym; ++i){
|
for(int i = 0; bltins[i].sym; ++i){
|
||||||
|
|||||||
1
dat.h
1
dat.h
@ -3,7 +3,6 @@
|
|||||||
typedef uintptr_t u64;
|
typedef uintptr_t u64;
|
||||||
typedef struct Object Object;
|
typedef struct Object Object;
|
||||||
typedef Object* (*Bltinfn)(Object *env, Object *args);
|
typedef Object* (*Bltinfn)(Object *env, Object *args);
|
||||||
typedef struct Object Object;
|
|
||||||
|
|
||||||
enum OType
|
enum OType
|
||||||
{
|
{
|
||||||
|
|||||||
4
error.c
4
error.c
@ -19,7 +19,7 @@ panic(char *fmt, ...)
|
|||||||
void
|
void
|
||||||
error(char *fmt, ...)
|
error(char *fmt, ...)
|
||||||
{
|
{
|
||||||
extern jmp_buf err;
|
extern jmp_buf *errptr;
|
||||||
va_list ap;
|
va_list ap;
|
||||||
|
|
||||||
va_start(ap, fmt);
|
va_start(ap, fmt);
|
||||||
@ -27,6 +27,6 @@ error(char *fmt, ...)
|
|||||||
vfprintf(stderr, fmt, ap);
|
vfprintf(stderr, fmt, ap);
|
||||||
va_end(ap);
|
va_end(ap);
|
||||||
fprintf(stderr, "\n");
|
fprintf(stderr, "\n");
|
||||||
longjmp(err, 1);
|
longjmp(*errptr, 1);
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
|
|||||||
23
eval.c
23
eval.c
@ -79,7 +79,8 @@ fndefine(Object *env, Object *list)
|
|||||||
Object *obj = find(env, list->car);
|
Object *obj = find(env, list->car);
|
||||||
if(obj)
|
if(obj)
|
||||||
return obj->cdr = val;
|
return obj->cdr = val;
|
||||||
return env->vars = newacons(gc, list->car, val, env->vars);
|
env->vars = newacons(gc, list->car, val, env->vars);
|
||||||
|
return env->vars;
|
||||||
}
|
}
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
@ -124,27 +125,29 @@ apply(Object *env, Object *fn, Object *args)
|
|||||||
if(islist(args) == 0)
|
if(islist(args) == 0)
|
||||||
error("args is not list type");
|
error("args is not list type");
|
||||||
switch(fn->type){
|
switch(fn->type){
|
||||||
case OBLTIN:
|
default: error("can't apply");
|
||||||
Bltinfn blt = bltinlookup(fn);
|
case OBLTIN:{
|
||||||
if(blt==0)
|
Bltinfn blt = bltinlookup(fn);
|
||||||
error("not builtin type!");
|
if(blt==0)
|
||||||
return blt(env, args);
|
error("not builtin type!");
|
||||||
|
return blt(env, args);
|
||||||
|
}
|
||||||
case OFUNC:{
|
case OFUNC:{
|
||||||
Object *elist = evallist(env, args);
|
Object *elist = evallist(env, args);
|
||||||
Object*res = applyfn(fn, elist);
|
Object*res = applyfn(fn, elist);
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
error("can't apply");
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
eval(Object *env, Object *obj)
|
eval(Object *env, Object *obj)
|
||||||
{
|
{
|
||||||
switch(obj->type){
|
switch(obj->type){
|
||||||
case OINT:
|
default:
|
||||||
|
error("can't eval");
|
||||||
case OSTRING:
|
case OSTRING:
|
||||||
|
case OINT:
|
||||||
case OBLTIN:
|
case OBLTIN:
|
||||||
case OSYMBOL:
|
case OSYMBOL:
|
||||||
return obj;
|
return obj;
|
||||||
@ -162,6 +165,4 @@ eval(Object *env, Object *obj)
|
|||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
error("can't apply");
|
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|||||||
1
fn.h
1
fn.h
@ -21,7 +21,6 @@ void* gcalloc(GC *,int);
|
|||||||
void* gcralloc(GC *, void*, int);
|
void* gcralloc(GC *, void*, int);
|
||||||
GC* newgc(void *top, int cap);
|
GC* newgc(void *top, int cap);
|
||||||
void gcrun(GC *);
|
void gcrun(GC *);
|
||||||
void gccompact(int cap, GC *src);
|
|
||||||
|
|
||||||
/* str.c */
|
/* str.c */
|
||||||
void strputc(Object*, int);
|
void strputc(Object*, int);
|
||||||
|
|||||||
142
gc.c
142
gc.c
@ -13,16 +13,6 @@ enum
|
|||||||
OFFSET = sizeof(int),
|
OFFSET = sizeof(int),
|
||||||
};
|
};
|
||||||
|
|
||||||
int
|
|
||||||
isobj(GC *gc, u64 p)
|
|
||||||
{
|
|
||||||
if(gc->ob <= p && p < gc->oe){
|
|
||||||
p -= gc->ob;
|
|
||||||
return (p % sizeof(Object)) == 0;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
cloneobj(GC *dst, GC *src, Object *obj)
|
cloneobj(GC *dst, GC *src, Object *obj)
|
||||||
{
|
{
|
||||||
@ -36,16 +26,18 @@ cloneobj(GC *dst, GC *src, Object *obj)
|
|||||||
obj->flag |= FORWARD;
|
obj->flag |= FORWARD;
|
||||||
obj->forward = p;
|
obj->forward = p;
|
||||||
switch(obj->type){
|
switch(obj->type){
|
||||||
|
default: panic("unreachable");
|
||||||
case OINT:
|
case OINT:
|
||||||
p->num = obj->num;
|
p->num = obj->num;
|
||||||
break;
|
break;
|
||||||
case OSTRING:
|
case OSTRING:
|
||||||
case OIDENT:
|
case OIDENT:{
|
||||||
int len = obj->ptr - obj->beg;
|
int len = obj->ptr - obj->beg;
|
||||||
p->beg = gcalloc(dst, len + 1);
|
p->beg = gcalloc(dst, len + 1);
|
||||||
p->end = p->ptr = p->beg + len;
|
p->end = p->ptr = p->beg + len;
|
||||||
memcpy(p->beg, obj->beg, len + 1);
|
memcpy(p->beg, obj->beg, len + 1);
|
||||||
break;
|
break;
|
||||||
|
}
|
||||||
case OCELL:
|
case OCELL:
|
||||||
p->car = cloneobj(dst, src, obj->car);
|
p->car = cloneobj(dst, src, obj->car);
|
||||||
p->cdr = cloneobj(dst, src, obj->cdr);
|
p->cdr = cloneobj(dst, src, obj->cdr);
|
||||||
@ -65,46 +57,48 @@ cloneobj(GC *dst, GC *src, Object *obj)
|
|||||||
}
|
}
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
forwardobj(Object *p)
|
moveobj(Object *p)
|
||||||
{
|
{
|
||||||
if(p == 0)
|
if(p == 0 || p->type == 0)
|
||||||
return 0;
|
return 0;
|
||||||
if(p->flag&FORWARD)
|
|
||||||
return p->forward;
|
|
||||||
switch(p->type){
|
switch(p->type){
|
||||||
|
default:
|
||||||
|
return p->forward;
|
||||||
case OBLTIN:
|
case OBLTIN:
|
||||||
case OSYMBOL:
|
case OSYMBOL:
|
||||||
break;
|
return p;
|
||||||
case OCELL:
|
|
||||||
p->car = forwardobj(p->car);
|
|
||||||
p->cdr = forwardobj(p->cdr);
|
|
||||||
break;
|
|
||||||
case OENV:
|
|
||||||
p->name = forwardobj(p->name);
|
|
||||||
p->vars = forwardobj(p->vars);
|
|
||||||
p->up = forwardobj(p->up);
|
|
||||||
break;
|
|
||||||
case OFUNC:
|
|
||||||
p->params = forwardobj(p->params);
|
|
||||||
p->body = forwardobj(p->body);
|
|
||||||
p->env = forwardobj(p->env);
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
return p;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
compact(u64 bot, GC *dst, GC *src)
|
forwardstack(u64 bot, GC *dst, GC *src)
|
||||||
{
|
{
|
||||||
for(Object *p=src->objs; p; p=p->next){
|
u64 pos, diff, *stk;
|
||||||
cloneobj(dst, src, p);
|
Object *moved, *org;
|
||||||
}
|
|
||||||
for(; bot < src->top; bot += sizeof(bot)){
|
for(; bot < src->top; bot += sizeof(bot)){
|
||||||
u64 val = (u64)*(void**)bot;
|
stk = (u64*)(void**)bot;
|
||||||
if(isobj(src, val)){
|
if(src->ob <= *stk && *stk < src->oe){
|
||||||
Object *obj = (Object*)val;
|
diff = (*stk - src->ob) % sizeof(Object);
|
||||||
if(obj->flag&FORWARD)
|
org = (Object*)(*stk - diff);
|
||||||
*(void**)bot = forwardobj(obj);
|
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;
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -116,8 +110,9 @@ gccompact(int cap, GC *src)
|
|||||||
u64 bot = (u64)&_;
|
u64 bot = (u64)&_;
|
||||||
GC *dst = newgc((void*)src->top, cap);
|
GC *dst = newgc((void*)src->top, cap);
|
||||||
dst->running = 1;
|
dst->running = 1;
|
||||||
compact(bot, dst, src);
|
for(Object *p=src->objs; p; p=p->next)
|
||||||
dst->running = 0;
|
cloneobj(dst, src, p);
|
||||||
|
forwardstack(bot, dst, src);
|
||||||
free(src->memory);
|
free(src->memory);
|
||||||
*src = *dst;
|
*src = *dst;
|
||||||
free(dst);
|
free(dst);
|
||||||
@ -174,6 +169,7 @@ gcalloc(GC *gc, int sz)
|
|||||||
i = j + *(int*)(j);
|
i = j + *(int*)(j);
|
||||||
}
|
}
|
||||||
panic("gccalloc : Not impl yet raise");
|
panic("gccalloc : Not impl yet raise");
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
void*
|
void*
|
||||||
@ -189,10 +185,12 @@ gcralloc(GC *gc, void *src, int sz)
|
|||||||
void
|
void
|
||||||
mark(GC *gc, 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;
|
return;
|
||||||
obj->flag = USING;
|
obj->flag = USING;
|
||||||
switch(obj->type){
|
switch(obj->type){
|
||||||
|
default:break;
|
||||||
case OCELL:
|
case OCELL:
|
||||||
mark(gc, obj->car);
|
mark(gc, obj->car);
|
||||||
mark(gc, obj->cdr);
|
mark(gc, obj->cdr);
|
||||||
@ -215,6 +213,8 @@ gcsweep(GC *gc)
|
|||||||
{
|
{
|
||||||
Object *last = 0;
|
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){
|
if(p->flag&USING){
|
||||||
p->flag &= ~(USING);
|
p->flag &= ~(USING);
|
||||||
last = p;
|
last = p;
|
||||||
@ -235,12 +235,26 @@ gcsweep(GC *gc)
|
|||||||
void
|
void
|
||||||
gcmark(GC *gc)
|
gcmark(GC *gc)
|
||||||
{
|
{
|
||||||
void *_ = 0;
|
u64 _ = 0, stk, diff;
|
||||||
u64 bot = (u64)&_;
|
u64 bot = (u64)&_;
|
||||||
|
Object *obj;
|
||||||
for(; bot < gc->top; bot += sizeof(bot)){
|
for(; bot < gc->top; bot += sizeof(bot)){
|
||||||
u64 val = (u64)*(void**)bot;
|
stk = (u64)*(void**)bot;
|
||||||
if(isobj(gc, val))
|
if(gc->ob <= stk && stk <= gc->oe){
|
||||||
mark(gc, (Object*)val);
|
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;
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -249,23 +263,23 @@ gcrun(GC *src)
|
|||||||
{
|
{
|
||||||
if(src->running)
|
if(src->running)
|
||||||
return;
|
return;
|
||||||
|
printf("BEFORE=> cap:%10ld using:%10ld remain:%10ld\n", src->cap, src->using, src->cap - src->using);
|
||||||
src->running = 1;
|
src->running = 1;
|
||||||
printf("before=> cap:%d using:%d remain:%d\n", gc->cap, gc->using, gc->cap-gc->using);
|
|
||||||
jmp_buf reg;
|
jmp_buf reg;
|
||||||
setjmp(reg);
|
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);
|
gcmark(src);
|
||||||
gcsweep(src);
|
gcsweep(src);
|
||||||
gccompact(src->cap + 500, src);
|
gccompact(src->cap + 500, src);
|
||||||
printf("after=> cap:%d using:%d remain:%d\n", gc->cap, gc->using, gc->cap-gc->using);
|
longjmp(reg, 1);
|
||||||
src->running = 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
newobj(GC *gc, enum OType type)
|
newobj(GC *gc, enum OType type)
|
||||||
{
|
{
|
||||||
if(gc->op + sizeof(Object) >= gc->oe){
|
|
||||||
panic("Not impl yet newobj raise");
|
|
||||||
}
|
|
||||||
gcrun(gc);
|
gcrun(gc);
|
||||||
gc->using += sizeof(Object);
|
gc->using += sizeof(Object);
|
||||||
Object *r = 0;
|
Object *r = 0;
|
||||||
@ -277,13 +291,9 @@ newobj(GC *gc, enum OType type)
|
|||||||
gc->op += sizeof(Object);
|
gc->op += sizeof(Object);
|
||||||
}
|
}
|
||||||
r->type = type;
|
r->type = type;
|
||||||
if(gc->objs == 0)
|
if(gc->objs)
|
||||||
gc->objs = r;
|
|
||||||
else{
|
|
||||||
r->next = gc->objs;
|
r->next = gc->objs;
|
||||||
gc->objs = r;
|
return gc->objs = r;
|
||||||
}
|
|
||||||
return r;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
GC*
|
GC*
|
||||||
|
|||||||
20
main.c
20
main.c
@ -3,7 +3,7 @@
|
|||||||
#include <setjmp.h>
|
#include <setjmp.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
jmp_buf err;
|
jmp_buf *errptr;
|
||||||
GC *gc;
|
GC *gc;
|
||||||
|
|
||||||
static void
|
static void
|
||||||
@ -12,6 +12,8 @@ SExprint(Object *obj)
|
|||||||
if(obj == 0)
|
if(obj == 0)
|
||||||
return;
|
return;
|
||||||
switch(obj->type){
|
switch(obj->type){
|
||||||
|
default:
|
||||||
|
return;
|
||||||
case OCELL:
|
case OCELL:
|
||||||
printf("(");
|
printf("(");
|
||||||
SExprint(obj->car);
|
SExprint(obj->car);
|
||||||
@ -34,6 +36,7 @@ SExprint(Object *obj)
|
|||||||
break;
|
break;
|
||||||
case OENV:
|
case OENV:
|
||||||
printf("<env>");
|
printf("<env>");
|
||||||
|
SExprint(obj->vars);
|
||||||
break;
|
break;
|
||||||
case OLAMBDA:
|
case OLAMBDA:
|
||||||
printf("<lambda>");
|
printf("<lambda>");
|
||||||
@ -57,16 +60,22 @@ printexpr(Object *obj)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
loop(Object *env)
|
loop(void)
|
||||||
{
|
{
|
||||||
if(setjmp(err) == 1){
|
Object *env = newenv(gc, &Nil, &Nil, &Nil);
|
||||||
|
jmp_buf buf;
|
||||||
|
errptr = &buf;
|
||||||
|
if(setjmp(buf) == 1){
|
||||||
skipline();
|
skipline();
|
||||||
gcrun(gc);
|
|
||||||
}
|
}
|
||||||
while(1){
|
while(1){
|
||||||
Object *res = nextexpr();
|
Object *res = nextexpr();
|
||||||
res = eval(env, res);
|
res = eval(env, res);
|
||||||
|
printf("=============res===========\n");
|
||||||
printexpr(res);
|
printexpr(res);
|
||||||
|
printf("=============env===========\n");
|
||||||
|
printexpr(env);
|
||||||
|
printf("===========================\n");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -74,6 +83,5 @@ int
|
|||||||
main(int argc, char *argv[])
|
main(int argc, char *argv[])
|
||||||
{
|
{
|
||||||
gc = newgc(&argc, 4000);
|
gc = newgc(&argc, 4000);
|
||||||
Object *env = newenv(gc, &Nil, &Nil, &Nil);
|
loop();
|
||||||
loop(env);
|
|
||||||
}
|
}
|
||||||
|
|||||||
2
makefile
2
makefile
@ -10,7 +10,7 @@ OFILES=\
|
|||||||
parser.o
|
parser.o
|
||||||
|
|
||||||
AS=$(CC) -c
|
AS=$(CC) -c
|
||||||
CFLAGS=-c -g -O0
|
CFLAGS=-c -g -O2 -Wall -std=c99
|
||||||
|
|
||||||
all: $(NAME)
|
all: $(NAME)
|
||||||
|
|
||||||
|
|||||||
2
obj.c
2
obj.c
@ -34,7 +34,7 @@ Object*
|
|||||||
newacons(GC *gc, Object *x, Object *y, Object *z)
|
newacons(GC *gc, Object *x, Object *y, Object *z)
|
||||||
{
|
{
|
||||||
Object *cons = newcons(gc, x, y);
|
Object *cons = newcons(gc, x, y);
|
||||||
return newcons(gc, cons, z);
|
return newcons(gc, cons ,z);
|
||||||
}
|
}
|
||||||
|
|
||||||
Object*
|
Object*
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user