diff --git a/include/picrin.h b/include/picrin.h index e2fa4212..b69141ac 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -51,6 +51,9 @@ typedef struct { pic_code *ip; pic_value *fp; struct pic_env *env; + int regc; + pic_value *regs; + struct pic_env *up; } pic_callinfo; typedef struct pic_block { diff --git a/include/picrin/proc.h b/include/picrin/proc.h index 34c12654..fc8c39cf 100644 --- a/include/picrin/proc.h +++ b/include/picrin/proc.h @@ -17,8 +17,8 @@ struct pic_func { struct pic_env { PIC_OBJECT_HEADER - pic_value *values; - int valuec; + pic_value *regs; + int regc; struct pic_env *up; pic_value storage[]; }; diff --git a/src/cont.c b/src/cont.c index a7052214..389e8a7b 100644 --- a/src/cont.c +++ b/src/cont.c @@ -208,7 +208,7 @@ cont_call(pic_state *pic) proc = pic_get_proc(pic); pic_get_args(pic, "*", &argc, &argv); - cont = (struct pic_cont *)pic_ptr(proc->env->values[0]); + cont = (struct pic_cont *)pic_ptr(pic_proc_cv_ref(pic, proc, 0)); cont->results = pic_list_by_array(pic, argc, argv); /* execute guard handlers */ diff --git a/src/gc.c b/src/gc.c index 424ea87c..807574c2 100644 --- a/src/gc.c +++ b/src/gc.c @@ -362,8 +362,8 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) struct pic_env *env = (struct pic_env *)obj; int i; - for (i = 0; i < env->valuec; ++i) { - gc_mark(pic, env->values[i]); + for (i = 0; i < env->regc; ++i) { + gc_mark(pic, env->regs[i]); } if (env->up) { gc_mark_object(pic, (struct pic_object *)env->up); diff --git a/src/proc.c b/src/proc.c index fafa25b6..eea16bc1 100644 --- a/src/proc.c +++ b/src/proc.c @@ -41,8 +41,8 @@ pic_proc_cv_init(pic_state *pic, struct pic_proc *proc, size_t cv_size) pic_error(pic, "env slot already in use"); } env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); - env->valuec = cv_size; - env->values = (pic_value *)pic_calloc(pic, cv_size, sizeof(pic_value)); + env->regc = cv_size; + env->regs = (pic_value *)pic_calloc(pic, cv_size, sizeof(pic_value)); env->up = NULL; proc->env = env; @@ -52,7 +52,7 @@ int pic_proc_cv_size(pic_state *pic, struct pic_proc *proc) { UNUSED(pic); - return proc->env ? proc->env->valuec : 0; + return proc->env ? proc->env->regc : 0; } pic_value @@ -61,7 +61,7 @@ pic_proc_cv_ref(pic_state *pic, struct pic_proc *proc, size_t i) if (proc->env == NULL) { pic_error(pic, "no closed env"); } - return proc->env->values[i]; + return proc->env->regs[i]; } void @@ -70,7 +70,7 @@ pic_proc_cv_set(pic_state *pic, struct pic_proc *proc, size_t i, pic_value v) if (proc->env == NULL) { pic_error(pic, "no closed env"); } - proc->env->values[i] = v; + proc->env->regs[i] = v; } static pic_value diff --git a/src/var.c b/src/var.c index b0d1f9f6..f9aad077 100644 --- a/src/var.c +++ b/src/var.c @@ -80,11 +80,11 @@ var_call(pic_state *pic) c = pic_get_args(pic, "|o", &v); if (c == 0) { - var = pic_var_ptr(proc->env->values[0]); + var = pic_var_ptr(proc->env->regs[0]); return pic_var_ref(pic, var); } else if (c == 1) { - var = pic_var_ptr(proc->env->values[0]); + var = pic_var_ptr(proc->env->regs[0]); pic_var_set(pic, var, v); return pic_none_value(); diff --git a/src/vm.c b/src/vm.c index ca3a11b8..51e1787a 100644 --- a/src/vm.c +++ b/src/vm.c @@ -424,17 +424,30 @@ pic_defvar(pic_state *pic, const char *name, pic_value init) pic_define(pic, name, pic_obj_value(pic_wrap_var(pic, var))); } +static void +vm_push_env(pic_state *pic) +{ + pic_callinfo *ci = pic->ci; + + ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * ci->regc, PIC_TT_ENV); + ci->env->up = ci->up; + ci->env->regc = ci->regc; + ci->env->regs = ci->regs; +} + static void vm_tear_off(pic_state *pic) { struct pic_env *env; int i; + assert(pic->ci->env != NULL); + env = pic->ci->env; - for (i = 0; i < env->valuec; ++i) { - env->storage[i] = env->values[i]; + for (i = 0; i < env->regc; ++i) { + env->storage[i] = env->regs[i]; } - env->values = env->storage; + env->regs = env->storage; } pic_value @@ -596,22 +609,22 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) int depth = c.u.r.depth; struct pic_env *env; - env = pic->ci->env; - while (depth--) { + env = pic->ci->up; + while (--depth) { env = env->up; } - PUSH(env->values[c.u.r.idx]); + PUSH(env->regs[c.u.r.idx]); NEXT; } CASE(OP_CSET) { int depth = c.u.r.depth; struct pic_env *env; - env = pic->ci->env; - while (depth--) { + env = pic->ci->up; + while (--depth) { env = env->up; } - env->values[c.u.r.idx] = POP(); + env->regs[c.u.r.idx] = POP(); NEXT; } CASE(OP_JMP) { @@ -720,10 +733,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) } /* prepare env */ - ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * irep->capturec, PIC_TT_ENV); - ci->env->up = proc->env; - ci->env->valuec = irep->capturec; - ci->env->values = ci->fp + irep->argc + irep->localc; + ci->up = proc->env; + ci->regc = irep->capturec; + ci->regs = ci->fp + irep->argc + irep->localc; pic->ip = irep->code; pic_gc_arena_restore(pic, ai); @@ -735,7 +747,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) pic_value *argv; pic_callinfo *ci; - vm_tear_off(pic); + if (pic->ci->env != NULL) { + vm_tear_off(pic); + } if (c.u.i == -1) { pic->sp += pic->ci[1].retc - 1; @@ -765,7 +779,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) goto L_STOP; } - vm_tear_off(pic); + if (pic->ci->env != NULL) { + vm_tear_off(pic); + } pic->ci->retc = c.u.i; @@ -797,6 +813,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) if (! pic_proc_irep_p(pic_proc_ptr(self))) { pic_error(pic, "logic flaw"); } + + if (pic->ci->env == NULL) { + vm_push_env(pic); + } + proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env); PUSH(pic_obj_value(proc)); pic_gc_arena_restore(pic, ai);