Hojun-Cho/clisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

handle error of return-from, block

Browse Source 
fix fnblock
This commit is contained in:
yoyo 2024-09-12 22:14:49 +09:00
parent a196cec636
commit 001eafc790
5 changed files with 27 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
eval.c
View File

@ -164,27 +164,26 @@ fnprogn(Object *env, Object *list)
Object* Object*
fnblock(Object *env, Object *list) fnblock(Object *env, Object *list)
{ {
if(list->type != OCELL) if(list->type != OCELL|| (list->car->type != OSYMBOL&&list->car->type != OIDENT))
error("Malformed block"); error("Malformed block");
Object *tag = car(list); Object *tag = car(list);
Object *body = cdr(list); Object *body = cdr(list);
Object *frame = curframe(env);
jmp_buf jmp; jmp_buf jmp;
Object *b = frame->block = newblock(gc, tag, curblock(env), body, &jmp); Object *b = newblock(gc, tag, curblock(env), body, &jmp);
Object *res = 0; Object *sp = env->sp;
sp->car->block = b;
Object *res = &Nil;
if(setjmp(jmp) == 1){ if(setjmp(jmp) == 1){
env->sp->block = b->up;
env->sp = sp;
res = env->retval; res = env->retval;
env->retval = 0; env->retval = &Nil;
Object *p = curblock(env);
for(;p!=b; p=p->up)
assert(p->tag != &Top);
curframe(env)->block = p->up;
return res; return res;
} }
res = progn(env, body); res = progn(env, body);
frame->block = frame->block->up; sp->car->block = b->up;
return res; return res;
} }

3
gc.c
View File

@ -42,7 +42,6 @@ findobj(GC *gc, uintptr_t *stk)
static Object* static Object*
cloneobj(GC *dst, GC *src, Object *obj) cloneobj(GC *dst, GC *src, Object *obj)
{ {
if(obj==0)return 0;
if(obj->type==OBLTIN||obj->type==OSYMBOL) return obj; if(obj->type==OBLTIN||obj->type==OSYMBOL) return obj;
if(obj->flag&FORWARD) return obj->forward; if(obj->flag&FORWARD) return obj->forward;
@ -133,7 +132,7 @@ gcraise(GC *src)
static void static void
mark(GC *gc, Object *obj) mark(GC *gc, Object *obj)
{ {
if(obj==0||obj->flag&USING||obj->type==ONONE||obj->type==OSYMBOL||obj->type==OBLTIN) if(obj->flag&USING||obj->type==ONONE||obj->type==OSYMBOL||obj->type==OBLTIN)
return; return;
obj->flag = USING; obj->flag = USING;

6
lib/lib.lisp
View File

@ -1,5 +1,5 @@
(defmacro defun (name args body) (defmacro defun (name args body)
`(define ,name (block ,name (lambda ,args ,body)))) `(define ,name (lambda ,args (block ,name ,body))))
(defmacro cond (expr . rest) (defmacro cond (expr . rest)
(if (not expr) (if (not expr)
@ -28,5 +28,9 @@
`(if (not ,test) `(if (not ,test)
(progn ,@rest))) (progn ,@rest)))
(defmacro return (res)
(return-from nil `,res))
(defun list (x . y) (cons x y)) (defun list (x . y) (cons x y))

1
obj.c
View File

@ -57,6 +57,7 @@ newenv(GC *gc, Object *frames, Object *bp, Object *sp)
env->frames = frames; env->frames = frames;
env->bp = bp; env->bp = bp;
env->sp = sp; env->sp = sp;
env->retval = &Nil;
return env; return env;
} }

11
repl.c
View File

@ -31,6 +31,16 @@ error(char *fmt, ...)
exit(1); exit(1);
} }
/* remove all frames except Top */
static void
clearenv(Object *env)
{
env->bp->cdr = &Nil;
env->bp->car->block = &Top;
env->sp = env->bp;
env->retval = &Nil;
}
static void static void
repl(Object *env, FILE *f, char *pre) repl(Object *env, FILE *f, char *pre)
{ {
@ -39,6 +49,7 @@ repl(Object *env, FILE *f, char *pre)
if(setjmp(err) == 1){ if(setjmp(err) == 1){
if(feof(f)) if(feof(f))
exit(1); exit(1);
clearenv(env);
skipline(f); skipline(f);
} }
while(1){ while(1){