Semantics fix: unhandled exceptions must still unwind.

* unwind.c (unhandled_ex): New static structure.
(unwind_to_exit_point): The code to print the unhandled exception info
and bail the process is moved here out of uw_throw. We do this in the
situation when we have an unhandled exception, which is represented
by the fact that the exception pointer points to the unhandled_ex
structure.
(uw_throw): If unhandled hook isn't a function, we don't abort; we go
through the unwinding and unhandled processing. Also, ditto if the
unhandled function returns, ditto. Unhandled processing is entered
by substituting unhandled_ex for the not-found exception, and
allowing unwind_to_exit point to be called.

* txr.1: Document new behavior for unhandled exceptions
and *unhandled-hook*.

2 files changed, 43 insertions, 36 deletions

diff --git a/txr.1 b/txr.1
index f8b2202e..44fe5eb8 100644
--- a/txr.1
+++ b/txr.1
@@ -28237,14 +28237,17 @@ macro.
 If no catch or accepting handler is found, control is transferred
 to the function stored in the
 .code *unhandled-hook*
-variable. If that function returns, the process terminates.
+variable. If that function returns, then unwinding is performed
+after which the process terminates (unless the unwinding actions
+intercept the control to prevent that).
 .IP -
 If no catch or accepting handler is found and
 .code *unhandled-hook*
 is
 .codn nil ,
 then a built-in strategy for handling the exception is invoked,
-consisting of printing some informational messages and terminating.
+consisting of unwinding, and then printing some informational messages and
+terminating.
 .PP
 
 From the above it should be evident that there are two ways by which exceptions
@@ -28674,25 +28677,25 @@ with the following arguments: the exception type symbol, the exception object,
 and a third value which is either
 .code nil
 or else the form which was being evaluated when the exception was thrown.
+The call occurs before any unwinding takes place.
 
-Otherwise, if the variable is
+If the variable is
+.codn nil ,
+or isn't a function, or the function returns after being called,
+then unwinding takes place, after which some informational messages are printed
+about the exception, and the process exits with a failed termination status.
+
+In the case when the variable contains a object other than
 .code nil
-some informational messages are printed about the exception, and the process
-exits with a failed termination status.
-In the same situation, if the variable contains an object which is not a
-function, the process terminates abnormally as if by a call to the
-.code abort
-function.
+which isn't a function, a diagnostic message is printed on the
+.code *stderr*
+stream prior to unwinding.
 
 Prior to the function being called, the
 .code *unhandled-hook*
 variable is reset to
 .codn nil .
 
-If the function registered in
-.code *unhandled-hook*
-returns, the process exits with a failed termination status.
-
 Note: the functions
 .code source-loc
 or
diff --git a/unwind.c b/unwind.c
index 52cb8832..dfc1d812 100644
--- a/unwind.c
+++ b/unwind.c
@@ -48,6 +48,7 @@ static uw_frame_t *uw_stack;
 static uw_frame_t *uw_env_stack;
 static uw_frame_t *uw_exit_point;
 static uw_frame_t toplevel_env;
+static uw_frame_t unhandled_ex;
 
 static val unhandled_hook_s, types_s, jump_s, sys_cont_s, sys_cont_poison_s;
 static val sys_cont_free_s, sys_capture_cont_s;
@@ -94,11 +95,32 @@ static void uw_unwind_to_exit_point(void)
     }
   }
 
-  if (!uw_stack)
-    abort();
+  if (uw_exit_point == &unhandled_ex) {
+    val sym = unhandled_ex.ca.sym;
+    val args = unhandled_ex.ca.args;
+
+    if (opt_loglevel >= 1) {
+      val prefix = format(nil, lit("~a:"), prog_string, nao);
+
+      format(std_error, lit("~a unhandled exception of type ~a:\n"),
+             prefix, sym, nao);
+
+      error_trace(sym, args, std_error, prefix);
+    }
+    if (uw_exception_subtype_p(sym, query_error_s) ||
+        uw_exception_subtype_p(sym, file_error_s)) {
+      if (opt_print_bindings)
+        put_line(lit("false"), std_output);
+    }
+
+    exit(EXIT_FAILURE);
+  }
 
   uw_exit_point = 0;
 
+  if (!uw_stack)
+    abort();
+
   switch (uw_stack->uw.type) {
   case UW_BLOCK:
     extended_longjmp(uw_stack->bl.jb, 1);
@@ -517,33 +539,15 @@ val uw_throw(val sym, val args)
       set(pfun, nil);
 
       if (fun) {
-        if (functionp(fun)) {
+        if (functionp(fun))
           funcall3(fun, sym, args, last_form_evaled);
-        } else {
+        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 prefix = format(nil, lit("~a:"), prog_string, nao);
-
-      format(std_error, lit("~a unhandled exception of type ~a:\n"),
-             prefix, sym, nao);
-
-      error_trace(sym, args, std_error, prefix);
-    }
-    if (uw_exception_subtype_p(sym, query_error_s) ||
-        uw_exception_subtype_p(sym, file_error_s)) {
-      if (opt_print_bindings)
-        put_line(lit("false"), std_output);
-    }
-
-    exit(EXIT_FAILURE);
+    ex = &unhandled_ex;
   }
 
   ex->ca.sym = sym;