TXR gets delimited continuations.

* unwind.c (sys_cont_s): New symbol variable.
(uw_pop_block): New function, supporting uw_block_end macro.
Special logic is needed for popping blocks now, because a
block can be a captured stub at the top of a continuation,
which must not be popped in the
regular manner.
(struct cont): New struct type.
(cont_destroy, cont_mark): New static functions.
(cont_ops): New static structure.
(revive_cont, capture_cont): New static functions.
(uw_capture_cont): New functions.
(uw_init): Initialize sys_cont_s.
Register sys:capture-cont intrinsic.

* unwind.h (enum uw_frtype): New enum member
UW_CAPTURED_BLOCK. When a block is captured as a stub copy of
the prompt block of a delimited continuation, its type is
changed from UW_BLOCK to this new type. This does two things:
it makes the block invisible to block-related code that does
nothing with continuations (code that looks for UW_BLOCK
and ignores anything else). Secondly, there is some special
handling related to UW_CAPTURED_BLOCK frames.
(uw_pop_block, uw_capture_cont): Declared.
(uw_block_begin): New local pointer uw_rslt introduced
which helps communicate the result variable over to the
uw_block_end macro (so we don't have to add a variable
argument to the latter).
(uw_block_end): Use uw_pop_block instead of uw_pop_frame.

* txr.1: Documented delimited continuations.

1 files changed, 7 insertions, 4 deletions

diff --git a/unwind.h b/unwind.h
index 97d1026a..d6753da4 100644
--- a/unwind.h
+++ b/unwind.h
@@ -32,7 +32,7 @@
 
 typedef union uw_frame uw_frame_t;
 typedef enum uw_frtype {
-  UW_BLOCK, UW_ENV, UW_CATCH, UW_HANDLE, UW_DBG
+  UW_BLOCK, UW_CAPTURED_BLOCK, UW_ENV, UW_CATCH, UW_HANDLE, UW_DBG
 } uw_frtype_t;
 
 struct uw_common {
@@ -123,12 +123,14 @@ void uw_push_debug(uw_frame_t *, val func, struct args *,
                    val ub_p_a_pairs, val env, val data,
                    val line, val chr);
 void uw_pop_frame(uw_frame_t *);
+void uw_pop_block(uw_frame_t *, val *pret);
 void uw_pop_until(uw_frame_t *);
 uw_frame_t *uw_current_frame(void);
 uw_frame_t *uw_current_exit_point(void);
 val uw_get_frames(void);
 val uw_find_frame(val extype, val frtype);
 val uw_invoke_catch(val catch_frame, val sym, struct args *);
+val uw_capture_cont(val tag, val ctx);
 void uw_init(void);
 void uw_late_init(void);
 
@@ -147,15 +149,16 @@ noreturn val type_mismatch(val, ...);
   obj_t *RESULTVAR = nil;                       \
   do {                                          \
     uw_frame_t uw_blk;                          \
+    obj_t **uw_rslt = &RESULTVAR;               \
     uw_push_block(&uw_blk, TAG);                \
     if (extended_setjmp(uw_blk.bl.jb)) {        \
       RESULTVAR = uw_blk.bl.result;             \
     } else {                                    \
       do { } while (0)
 
-#define uw_block_end                    \
-    }                                   \
-    uw_pop_frame(&uw_blk);              \
+#define uw_block_end                            \
+    }                                           \
+    uw_pop_block(&uw_blk, uw_rslt);             \
   } while (0)
 
 #define uw_env_begin                    \