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

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

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

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

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

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

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