diff --git a/include/picrin/proc.h b/include/picrin/proc.h index 21a24b21..89d06163 100644 --- a/include/picrin/proc.h +++ b/include/picrin/proc.h @@ -29,4 +29,10 @@ struct pic_proc { struct pic_proc *pic_proc_new(pic_state *, pic_func_t); struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *); +/* closed variables accessor */ +void pic_proc_cv_reserve(pic_state *, struct pic_proc *, size_t); +int pic_proc_cv_size(pic_state *, struct pic_proc *); +pic_value pic_proc_cv_ref(pic_state *, struct pic_proc *, size_t); +void pic_proc_cv_set(pic_state *, struct pic_proc *, size_t, pic_value); + #endif diff --git a/src/cont.c b/src/cont.c index 63e856ff..ec5d311c 100644 --- a/src/cont.c +++ b/src/cont.c @@ -164,11 +164,8 @@ pic_cont_callcc(pic_state *pic) c = pic_proc_new(pic, cont_call); /* save the continuation object in proc */ - c->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); - c->env->up = NULL; - c->env->valuec = 1; - c->env->values = (pic_value *)pic_calloc(pic, 1, sizeof(pic_value)); - c->env->values[0] = pic_obj_value(cont); + pic_proc_cv_reserve(pic, c, 1); + pic_proc_cv_set(pic, c, 0, pic_obj_value(cont)); return pic_apply_argv(pic, cb, 1, pic_obj_value(c)); } diff --git a/src/proc.c b/src/proc.c index 759b0446..6f772de8 100644 --- a/src/proc.c +++ b/src/proc.c @@ -27,6 +27,46 @@ pic_proc_new_irep(pic_state *pic, struct pic_irep *irep, struct pic_env *env) return proc; } +void +pic_proc_cv_reserve(pic_state *pic, struct pic_proc *proc, size_t cv_size) +{ + struct pic_env *env; + + if (proc->env != NULL) { + 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->up = NULL; + + proc->env = env; +} + +int +pic_proc_cv_size(pic_state *pic, struct pic_proc *proc) +{ + return proc->env ? proc->env->valuec : 0; +} + +pic_value +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]; +} + +void +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; +} + static pic_value pic_proc_proc_p(pic_state *pic) {