Implementing sys:abscond-from operator.

* eval.c (sys_abscond_from_s): New symbol variable.
(op_abscond_from): New static function.
(do_expand): Handle abscond-from like return-from.
(eval_init): Initialize sys_abscond_from_s and
register sys:abscond-from operator.

* share/txr/stdlib/yield.tl  (yield-from): Use
sys:abscond-from instead of return-from, to avoid
tearing down the continuation's resources that it may
need when restarted.

* txr.1: Documented sys:abscond-from and added
a mention to the Delimited Continuations introduction.

* unwind.c (uw_abscond_to_exit_point): New static function.
(uw_block_abscond): New function.

* unwind.h (uw_block_abscond): Declared.

1 files changed, 47 insertions, 0 deletions

diff --git a/unwind.c b/unwind.c
index fe3c68b6..c679c54e 100644
--- a/unwind.c
+++ b/unwind.c
@@ -114,6 +114,34 @@ static void uw_unwind_to_exit_point(void)
   }
 }
 
+static void uw_abscond_to_exit_point(void)
+{
+  assert (uw_exit_point);
+
+  for (; uw_stack && uw_stack != uw_exit_point; uw_stack = uw_stack->uw.up) {
+    switch (uw_stack->uw.type) {
+    case UW_ENV:
+      uw_env_stack = uw_env_stack->ev.up_env;
+      break;
+    default:
+      break;
+    }
+  }
+
+  if (!uw_stack)
+    abort();
+
+  uw_exit_point = 0;
+
+  switch (uw_stack->uw.type) {
+  case UW_BLOCK:
+    extended_longjmp(uw_stack->bl.jb, 1);
+    abort();
+  default:
+    abort();
+  }
+}
+
 void uw_push_block(uw_frame_t *fr, val tag)
 {
   memset(fr, 0, sizeof *fr);
@@ -356,6 +384,25 @@ val uw_block_return_proto(val tag, val result, val protocol)
   abort();
 }
 
+val uw_block_abscond(val tag, val result)
+{
+  uw_frame_t *ex;
+
+  for (ex = uw_stack; ex != 0; ex = ex->uw.up) {
+    if (ex->uw.type == UW_BLOCK && ex->bl.tag == tag)
+      break;
+  }
+
+  if (ex == 0)
+    return nil;
+
+  ex->bl.result = result;
+  ex->bl.protocol = nil;
+  uw_exit_point = ex;
+  uw_abscond_to_exit_point();
+  abort();
+}
+
 void uw_push_catch(uw_frame_t *fr, val matches)
 {
   memset(fr, 0, sizeof *fr);