New way of handling exceptions without unwinding.

* eval.c (handler_bind_s): New symbol variable.
(op_handler_bind): New static function.
(do_expand): Traverse handler-bind forms.
(eval_init): Initialize handler_bind_s variable and register handler-bind
operator.

* lisplib.c (except_set_entries, except_instantiate): New functions.
(lisplib_init): Register new functions in dl_table.

* parser.c (intr_s): New symbol variable.
(repl_intr): Throw exception of type intr, rather than error.
This way we can interrupt accidental exception handling loops involving
exceptions derived from error.
(parse_init): Initialize intr_s.

* share/txr/stdlib/except.tl: New file, defines handle macro.

* unwind.c (uw_push_handler): New function.
(invoke_handler): New static function.
(uw_throw): Search loop looks for and processes handlers in addition to
catches.

* unwind.h (uw_frtype_t): New enum member, UW_HANDLE.
(struct uw_catch): Move member visible so it
is in the same position as in struct uw_handler.
(struct uw_handler): New struct type.
(union uw_frame): New member ha of type struct uw_handler.
(uw_push_handler): Function declared.

* txr.1: Added introductory paragraphs to Exception Handling section.
Documented handler-bind and handle. Some minor errors corrected.

1 files changed, 14 insertions, 2 deletions

diff --git a/unwind.h b/unwind.h
index 2089608a..207b8ce9 100644
--- a/unwind.h
+++ b/unwind.h
@@ -31,7 +31,9 @@
 #endif
 
 typedef union uw_frame uw_frame_t;
-typedef enum uw_frtype { UW_BLOCK, UW_ENV, UW_CATCH, UW_DBG } uw_frtype_t;
+typedef enum uw_frtype {
+  UW_BLOCK, UW_ENV, UW_CATCH, UW_HANDLE, UW_DBG
+} uw_frtype_t;
 
 struct uw_common {
   uw_frame_t *up;
@@ -59,13 +61,21 @@ struct uw_catch {
   uw_frame_t *up;
   uw_frtype_t type;
   val matches;
+  int visible;
   val sym;
   val args;
   uw_frame_t *cont;
-  int visible;
   extended_jmp_buf jb;
 };
 
+struct uw_handler {
+  uw_frame_t *up;
+  uw_frtype_t type;
+  val matches; /* Same position as in uw_catch! */
+  int visible; /* Likewise. */
+  val fun;
+};
+
 struct uw_debug {
   uw_frame_t *up;
   uw_frtype_t type;
@@ -83,6 +93,7 @@ union uw_frame {
   struct uw_block bl;
   struct uw_dynamic_env ev;
   struct uw_catch ca;
+  struct uw_handler ha;
   struct uw_debug db;
 };
 
@@ -98,6 +109,7 @@ INLINE val uw_block_return(val tag, val result)
    return uw_block_return_proto(tag, result, nil);
 }
 void uw_push_catch(uw_frame_t *, val matches);
+void uw_push_handler(uw_frame_t *, val matches, val fun);
 noreturn val uw_throw(val sym, val exception);
 noreturn val uw_throwv(val sym, struct args *);
 noreturn val uw_throwf(val sym, val fmt, ...);