* unwind.c (unhandled_hook_s): New static variable.

(uw_throw): In the unhandled case, check if *unhandled-hook* variable
has a function, and use it instead of the default logic. If it's not a
function, abort with an error message. Clear it so that if the hook
function re-enters this code, it will not be used. Always exit now on
unhandled exceptions; do not abort.
(uw_late_init): New function.

* unwind.h (uw_late_init): Declared.

* lib.c (init): Call uw_late_init.

* txr.1: Documented *unhandled-hook*.

* genvim.txr: Scan the unwind.c file, since it has a reg_var now.

* tl.vim, txr.vim: Updated.

1 files changed, 29 insertions, 2 deletions

diff --git a/unwind.c b/unwind.c
index 217e24f9..05ff6335 100644
--- a/unwind.c
+++ b/unwind.c
@@ -47,6 +47,8 @@ static uw_frame_t *uw_env_stack;
 static uw_frame_t *uw_exit_point;
 static uw_frame_t toplevel_env;
 
+static val unhandled_hook_s;
+
 /* C99 inline instantiations. */
 #if __STDC_VERSION__ >= 199901L
 val uw_block_return(val tag, val result);
@@ -280,6 +282,25 @@ val uw_throw(val sym, val exception)
       abort();
     }
 
+    {
+      loc pfun = lookup_var_l(nil, unhandled_hook_s);
+      val fun = deref(pfun);
+
+      set(pfun, nil);
+
+      if (fun) {
+        if (functionp(fun)) {
+          funcall3(fun, sym, exception, last_form_evaled);
+        } else {
+          format(std_error, lit("~a: *unhandled-hook* ~s isn't a function\n"),
+                            prog_string, fun, nao);
+          abort();
+        }
+
+        exit(EXIT_FAILURE);
+      }
+    }
+
     if (opt_loglevel >= 1) {
       val s = stringp(exception);
       val info = if2(source_loc(last_form_evaled),
@@ -298,9 +319,9 @@ val uw_throw(val sym, val exception)
         uw_exception_subtype_p(sym, file_error_s)) {
       if (opt_print_bindings)
         put_line(lit("false"), std_output);
-      exit(EXIT_FAILURE);
     }
-    abort();
+
+    exit(EXIT_FAILURE);
   }
 
   ex->ca.sym = sym;
@@ -439,3 +460,9 @@ void uw_init(void)
   uw_register_subtype(assert_s, error_s);
   uw_register_subtype(syntax_error_s, error_s);
 }
+
+void uw_late_init(void)
+{
+  reg_var(unhandled_hook_s = intern(lit("*unhandled-hook*"),
+          user_package), nil);
+}