From f6f3064b404c362855fa840e8cbd86a8016c6418 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 13 May 2017 02:02:34 +0900 Subject: [PATCH] bugfix: dyn_env is not properly restored on delim-cont call --- lib/ext/cont.c | 14 ++++++++------ lib/ext/error.c | 4 ++-- lib/gc.c | 3 --- lib/state.c | 6 ++---- lib/state.h | 1 - lib/var.c | 10 +++++----- 6 files changed, 17 insertions(+), 21 deletions(-) diff --git a/lib/ext/cont.c b/lib/ext/cont.c index 0ec6dc74..6d0a5d24 100644 --- a/lib/ext/cont.c +++ b/lib/ext/cont.c @@ -17,7 +17,7 @@ static pic_value pic_cont_reset(pic_state *pic) { - pic_value thunk; + pic_value thunk, prev = pic_ref(pic, "__picrin_dynenv__"); struct context cxt; pic_get_args(pic, "l", &thunk); @@ -25,21 +25,23 @@ pic_cont_reset(pic_state *pic) CONTEXT_INITK(pic, &cxt, thunk, pic->halt, 0, (pic_value *) NULL); cxt.reset = 1; pic_vm(pic, &cxt); + pic_set(pic, "__picrin_dynenv__", prev); return pic_protect(pic, cxt.fp->regs[1]); } static pic_value shift_call(pic_state *pic) { - pic_value x; + pic_value x, prev = pic_ref(pic, "__picrin_dynenv__"); struct context cxt; pic_get_args(pic, "o", &x); CONTEXT_INIT(pic, &cxt, pic_closure_ref(pic, 0), 1, &x); cxt.reset = 1; - pic->dyn_env = pic_closure_ref(pic, 1); + pic_set(pic, "__picrin_dynenv__", pic_closure_ref(pic, 1)); pic_vm(pic, &cxt); + pic_set(pic, "__picrin_dynenv__", prev); return pic_protect(pic, cxt.fp->regs[1]); } @@ -54,7 +56,7 @@ pic_cont_shift(pic_state *pic) pic_error(pic, "c function call interleaved in delimited continuation", 0); } - k = pic_lambda(pic, shift_call, 2, pic->cxt->fp->regs[1], pic->dyn_env); + k = pic_lambda(pic, shift_call, 2, pic->cxt->fp->regs[1], pic_ref(pic, "__picrin_dynenv__")); CONTEXT_INITK(pic, pic->cxt, f, pic->halt, 1, &k); return pic_invalid_value(pic); } @@ -85,7 +87,7 @@ cont_call(pic_state *pic) } pic->cxt = pic->cxt->prev; } - pic->dyn_env = dyn_env; + pic_set(pic, "__picrin_dynenv__", dyn_env); longjmp(cxt->jmp, 1); PIC_UNREACHABLE(); @@ -96,7 +98,7 @@ pic_make_cont(pic_state *pic, pic_value k) { static const pic_data_type cxt_type = { "cxt", NULL }; pic_value c; - c = pic_lambda(pic, cont_call, 4, pic_true_value(pic), pic_data_value(pic, pic->cxt, &cxt_type), k, pic->dyn_env); + c = pic_lambda(pic, cont_call, 4, pic_true_value(pic), pic_data_value(pic, pic->cxt, &cxt_type), k, pic_ref(pic, "__picrin_dynenv__")); pic->cxt->conts = pic_cons(pic, c, pic->cxt->conts); return c; } diff --git a/lib/ext/error.c b/lib/ext/error.c index 88992586..07339051 100644 --- a/lib/ext/error.c +++ b/lib/ext/error.c @@ -52,7 +52,7 @@ pic_enter_try(pic_state *pic) var = pic_exc(pic); env = pic_make_attr(pic); pic_attr_set(pic, env, var, pic_cons(pic, handler, pic_call(pic, var, 0))); - pic->dyn_env = pic_cons(pic, env, pic->dyn_env); + pic_set(pic, "__picrin_dynenv__", pic_cons(pic, env, pic_ref(pic, "__picrin_dynenv__"))); pic_leave(pic, pic->cxt->ai); } @@ -62,7 +62,7 @@ pic_exit_try(pic_state *pic) { struct context *cxt = pic->cxt; pic_value c, it; - pic->dyn_env = pic_cdr(pic, pic->dyn_env); + pic_set(pic, "__picrin_dynenv__", pic_cdr(pic, pic_ref(pic, "__picrin_dynenv__"))); pic_for_each (c, cxt->conts, it) { proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic); } diff --git a/lib/gc.c b/lib/gc.c index 6ee1772c..302eebd0 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -336,9 +336,6 @@ gc_mark_phase(pic_state *pic) /* global variables */ gc_mark(pic, pic->globals); - /* dynamic environment */ - gc_mark(pic, pic->dyn_env); - /* top continuation */ gc_mark(pic, pic->halt); diff --git a/lib/state.c b/lib/state.c index 19604231..260608b4 100644 --- a/lib/state.c +++ b/lib/state.c @@ -48,6 +48,8 @@ pic_init_core(pic_state *pic) size_t ai = pic_enter(pic); pic_define(pic, "__picrin_features__", pic_nil_value(pic)); + pic_define(pic, "__picrin_dynenv__", pic_list(pic, 1, pic_make_attr(pic))); + pic_init_bool(pic); DONE; pic_init_pair(pic); DONE; pic_init_number(pic); DONE; @@ -137,9 +139,6 @@ pic_open(pic_allocf allocf, void *userdata, pic_panicf panicf) /* global variables */ pic->globals = pic_make_dict(pic); - /* dynamic environment */ - pic->dyn_env = pic_list(pic, 1, pic_make_attr(pic)); - /* top continuation */ { static const code_t halt_code[] = { 0x00 }; @@ -186,7 +185,6 @@ pic_close(pic_state *pic) pic->ai = 0; pic->halt = pic_invalid_value(pic); pic->globals = pic_invalid_value(pic); - pic->dyn_env = pic_invalid_value(pic); assert(pic->cxt->ai == 0); assert(pic->cxt->pc == NULL); diff --git a/lib/state.h b/lib/state.h index d2344d4d..eef985f1 100644 --- a/lib/state.h +++ b/lib/state.h @@ -38,7 +38,6 @@ struct pic_state { struct context *cxt, default_cxt; size_t ai; - pic_value dyn_env; khash_t(oblist) oblist; /* string to symbol */ pic_value globals; /* dict */ diff --git a/lib/var.c b/lib/var.c index e9eff1c7..a571a451 100644 --- a/lib/var.c +++ b/lib/var.c @@ -20,7 +20,7 @@ var_call(pic_state *pic) if (n == 0) { pic_value env, it; - pic_for_each(env, pic->dyn_env, it) { + pic_for_each(env, pic_ref(pic, "__picrin_dynenv__"), it) { if (pic_attr_has(pic, env, self)) { return pic_attr_ref(pic, env, self); } @@ -33,7 +33,7 @@ var_call(pic_state *pic) if (! pic_false_p(pic, conv)) { val = pic_call(pic, conv, 1, val); } - pic_attr_set(pic, pic_car(pic, pic->dyn_env), self, val); + pic_attr_set(pic, pic_car(pic, pic_ref(pic, "__picrin_dynenv__")), self, val); return pic_undef_value(pic); } } @@ -41,7 +41,7 @@ var_call(pic_state *pic) pic_value pic_make_var(pic_state *pic, pic_value init, pic_value conv) { - pic_value var, env = pic->dyn_env; + pic_value var, env = pic_ref(pic, "__picrin_dynenv__"); var = pic_lambda(pic, var_call, 1, conv); while (1) { @@ -76,9 +76,9 @@ pic_var_current_dynamic_environment(pic_state *pic) n = pic_get_args(pic, "|o", &dyn_env); if (n == 0) { - return pic->dyn_env; + return pic_ref(pic, "__picrin_dynenv__"); } else { - pic->dyn_env = dyn_env; + pic_set(pic, "__picrin_dynenv__", dyn_env); return pic_undef_value(pic); } }