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, 40 insertions, 0 deletions

diff --git a/unwind.c b/unwind.c
index 6f488ae3..ab307dd0 100644
--- a/unwind.c
+++ b/unwind.c
@@ -247,6 +247,17 @@ void uw_push_catch(uw_frame_t *fr, val matches)
   uw_stack = fr;
 }
 
+void uw_push_handler(uw_frame_t *fr, val matches, val fun)
+{
+  memset(fr, 0, sizeof *fr);
+  fr->ha.type = UW_HANDLE;
+  fr->ha.matches = matches;
+  fr->ha.fun = fun;
+  fr->ha.visible = 1;
+  fr->ha.up = uw_stack;
+  uw_stack = fr;
+}
+
 static val exception_subtypes;
 
 val uw_exception_subtype_p(val sub, val sup)
@@ -259,6 +270,21 @@ val uw_exception_subtype_p(val sub, val sup)
   }
 }
 
+static void invoke_handler(uw_frame_t *fr, struct args *args)
+{
+  fr->ha.visible = 0;
+
+  uw_simple_catch_begin;
+
+  generic_funcall(fr->ha.fun, args);
+
+  uw_unwind {
+    fr->ha.visible = 1;
+  }
+
+  uw_catch_end;
+}
+
 val uw_throw(val sym, val args)
 {
   uw_frame_t *ex;
@@ -285,6 +311,20 @@ val uw_throw(val sym, val args)
       if (match)
         break;
     }
+    if (ex->uw.type == UW_HANDLE && ex->ha.visible) {
+      val matches = ex->ha.matches;
+      val match;
+      for (match = matches; match; match = cdr(match))
+        if (uw_exception_subtype_p(sym, car(match)))
+          break;
+      if (match) {
+        args_decl(gf_args, ARGS_MAX);
+        args_init_list(gf_args, ARGS_MAX, cons(sym, args));
+        --reentry_count;
+        invoke_handler(ex, gf_args);
+        ++reentry_count;
+      }
+    }
   }
 
   if (ex == 0) {