Copy envs for middle-of-binding continuations.

When continuations are captured/restored in the middle of
variable binding constructs, a hidden problem occurs.
Binding constructs work by allocating an empty environment
and then destructively extending it. Since the environment
is not on the stack, but a referenced object, it doesn't
get deep copied into a continuation. As the continuation is
revived repeatedly, parts of the variable binding code are
repeatedly re-executed, and keep pushing fresh bindings into
the same environment object. Though the new bindings
correctly shadow the old, the old bindings are there and
potentially hang on to garbage.

The solution taken here is to introduce a new kind of frame
for handling the situation: a continuation copy handling
frame. This frame allows functions to register objects to
be copied more deeply if a continuation is captured/revived
across them.

* eval.c (copy_env): New static function.
(copy_env_handler): New static function.
(bind_args, bind_macro_params): Install continuation copy
handling frame for cloning new_env.
(struct bindings_helper_vars): New struct type.
(copy_bh_env_handler): New static function.
(bindings_helper): Install continuation copy handling frame
for de and ne variables which hold environments. The variables
are moved to a struct to facilitate access from the handler.

* eval.h (copy_env): Declared.

* unwind.c (uw_push_cont_copy): New function.
(call_copy_handler): New static function.
(revive_cont): When a continuation is being revived invoke the
copying actions in its continuation copy handling frames,
but not if it is only being temporarily revived for immediate
unwinding.
(capture_cont): After copying the continuation, invoke any
continuation copying frames in the "parent": the original
frames that were captured.

* unwind.h (enum uw_frtype): New type, UW_CONT_COPY.
(struct uw_cont_copy): New struct type.
(union uw_frame): New member cp.
(uw_push_cont_copy): Declared.

1 files changed, 27 insertions, 1 deletions

diff --git a/unwind.c b/unwind.c
index a3f63038..cf242b20 100644
--- a/unwind.c
+++ b/unwind.c
@@ -365,6 +365,17 @@ val uw_invoke_catch(val catch_frame, val sym, struct args *args)
   abort();
 }
 
+void uw_push_cont_copy(uw_frame_t *fr, mem_t *ptr,
+                       void (*copy)(mem_t *ptr, int parent))
+{
+  memset(fr, 0, sizeof *fr);
+  fr->cp.type = UW_CONT_COPY;
+  fr->cp.ptr = ptr;
+  fr->cp.copy = copy;
+  fr->cp.up = uw_stack;
+  uw_stack = fr;
+}
+
 val uw_block_return_proto(val tag, val result, val protocol)
 {
   uw_frame_t *ex;
@@ -705,6 +716,16 @@ static struct cobj_ops cont_ops = cobj_ops_init(eq,
                                                 cont_mark,
                                                 cobj_hash_op);
 
+static void call_copy_handlers(uw_frame_t *upto, int parent)
+{
+  uw_frame_t *fr;
+
+  for (fr = uw_stack; fr != 0 && fr != upto; fr = fr->uw.up) {
+    if (fr->uw.type == UW_CONT_COPY)
+      fr->cp.copy(fr->cp.ptr, parent);
+  }
+}
+
 static val revive_cont(val dc, val arg)
 {
   const int frame_slack = 32 * sizeof (val);
@@ -754,6 +775,9 @@ static val revive_cont(val dc, val arg)
 
     bug_unless (uw_stack->uw.type == UW_BLOCK);
 
+    if (arg != sys_cont_poison_s)
+      call_copy_handlers(&uw_blk, 0);
+
     uw_stack->bl.result = arg;
     uw_exit_point = if3(arg == sys_cont_poison_s, &uw_blk, uw_stack);
     uw_unwind_to_exit_point();
@@ -802,8 +826,10 @@ static val capture_cont(val tag, val fun, uw_frame_t *block)
 
   uw_block_end;
 
-  if (cont_obj)
+  if (cont_obj) {
+    call_copy_handlers(block, 0);
     result = funcall1(fun, func_f1(cont_obj, revive_cont));
+  }
 
   return result;
 }