diff --git a/include/picrin.h b/include/picrin.h index ebc60ee1..f16adcea 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -15,6 +15,7 @@ typedef struct pic_callinfo { int argc; struct pic_code *pc; pic_value *fp; + struct pic_env *env; } pic_callinfo; typedef struct { diff --git a/src/gc.c b/src/gc.c index c5342746..af76fd14 100644 --- a/src/gc.c +++ b/src/gc.c @@ -204,6 +204,7 @@ static void gc_mark_phase(pic_state *pic) { pic_value *stack; + pic_callinfo *ci; int i; /* stack */ @@ -211,6 +212,11 @@ gc_mark_phase(pic_state *pic) gc_mark(pic, *stack); } + /* callinfo */ + for (ci = pic->ci; ci != pic->cibase; --ci) { + gc_mark_object(pic, (struct pic_object *)ci->env); + } + /* arena */ for (i = 0; i < pic->arena_idx; ++i) { gc_mark_object(pic, pic->arena[i]); diff --git a/src/vm.c b/src/vm.c index 16b04bea..4c4c2674 100644 --- a/src/vm.c +++ b/src/vm.c @@ -268,7 +268,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) int depth = pc->u.c.depth; struct pic_env *env; - env = pic_proc_ptr(*pic->ci->fp)->env; + env = pic->ci->env; while (depth--) { env = env->up; } @@ -279,7 +279,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) int depth = pc->u.c.depth; struct pic_env *env; - env = pic_proc_ptr(*pic->ci->fp)->env; + env = pic->ci->env; while (depth--) { env = env->up; } @@ -342,9 +342,16 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) } PUSH(rest); } - for (i = 0; i < proc->u.irep->argc; ++i) { - proc->env->values[i] = ci->fp[i]; + + /* prepare env */ + ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); + ci->env->up = proc->env; + ci->env->num_val = proc->u.irep->argc; + ci->env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * ci->env->num_val); + for (i = 0; i < ci->env->num_val; ++i) { + ci->env->values[i] = ci->fp[i]; } + pc = proc->u.irep->code; pic_gc_arena_restore(pic, ai); JUMP; @@ -370,18 +377,8 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) } CASE(OP_LAMBDA) { struct pic_proc *proc; - struct pic_env *env; - int i; - env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); - env->num_val = pic->irep[pc->u.i]->argc; - env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * env->num_val); - for (i = 0; i < env->num_val; ++i) { - env->values[i] = pic_undef_value(); - } - env->up = pic_proc_ptr(*pic->ci->fp)->env; - - proc = pic_proc_new(pic, pic->irep[pc->u.i], env); + proc = pic_proc_new(pic, pic->irep[pc->u.i], pic->ci->env); PUSH(pic_obj_value(proc)); pic_gc_arena_restore(pic, ai); NEXT; diff --git a/t/closure.scm b/t/closure.scm new file mode 100644 index 00000000..b74568e2 --- /dev/null +++ b/t/closure.scm @@ -0,0 +1,20 @@ +(begin + + (define foo (lambda (a) + (lambda () + a))) + (define bar (foo 1)) + + ; must be 1 + (write (bar)) + (newline) + + (define baz (foo 2)) + + ; must be 2 + (write (baz)) + (newline) + + ; must be 1 + (write (bar)) + (newline))