conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

bugfix: dyn_env is not properly restored on delim-cont call

This commit is contained in:
Yuichi Nishiwaki 2017-05-13 02:02:34 +09:00
parent 247987f09d
commit f6f3064b40
6 changed files with 17 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lib/ext/cont.c
View File

@ -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;
}

4
lib/ext/error.c
View File

@ -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);
}

3
lib/gc.c
View File

@ -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);

6
lib/state.c
View File

@ -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);

1
lib/state.h
View File

@ -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 */

10
lib/var.c
View File

@ -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);
}
}