From 7a926eb8da998fba873900fadc4f2fa179e7319f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 6 Jul 2021 06:01:01 -0700
Subject: unwind: refer to top-level *stderr* stream.

Exception processing should refer to the original, top-level
value of *stderr* rather than the current dynamic value, even
if unwinding has not yet taken place. Using the dynamic value
can not only cause critical output to disappear, but it leads
to a false positive identification of the "unhandled exception
in early initialization" situation, a diagnostic which is
emitted on the C stderr if the Lisp one is unavailable,
which is assumed to be due to initialization not having
yet completed.

* stream.c (top_stderr): New global variable.
(stream_init): GC-protect top_stderr, and initialize it with
the same object that goes into the *stderr* top-level binding.

* stream.h (top_stderr): Declared.

* unwind.c (uw_unwind_to_exit_point, uw_rthrow): Use
top_stderr instead of std_error macro.
---
 stream.c |  5 ++++-
 stream.h |  2 ++
 unwind.c | 16 ++++++++--------
 3 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/stream.c b/stream.c
index 4f4edbe3..87eb3383 100644
--- a/stream.c
+++ b/stream.c
@@ -101,6 +101,8 @@ val socket_error_s;
 
 const wchli_t *path_sep_chars = wli("/");
 
+val top_stderr;
+
 val shell, shell_arg;
 
 void strm_base_init(struct strm_base *s)
@@ -5253,6 +5255,7 @@ void stream_init(void)
 {
   prot1(&ap_regex);
   prot1(&plp_regex);
+  prot1(&top_stderr);
 
   detect_format_string();
   detect_path_separators();
@@ -5298,7 +5301,7 @@ void stream_init(void)
   reg_var(stddebug_s = intern(lit("*stddebug*"), user_package),
           make_stdio_stream(stdout, lit("debug")));
   reg_var(stderr_s = intern(lit("*stderr*"), user_package),
-          make_stdio_stream(stderr, lit("stderr")));
+          top_stderr = make_stdio_stream(stderr, lit("stderr")));
   reg_var(stdnull_s = intern(lit("*stdnull*"), user_package),
           make_null_stream());
 
diff --git a/stream.h b/stream.h
index 0030465c..410913af 100644
--- a/stream.h
+++ b/stream.h
@@ -150,6 +150,8 @@ extern val socket_error_s;
 
 extern const wchli_t *path_sep_chars;
 
+extern val top_stderr;
+
 void strm_base_init(struct strm_base *s);
 void strm_base_cleanup(struct strm_base *s);
 void strm_base_mark(struct strm_base *s);
diff --git a/unwind.c b/unwind.c
index 0815a885..60746003 100644
--- a/unwind.c
+++ b/unwind.c
@@ -110,7 +110,7 @@ static void uw_unwind_to_exit_point(void)
     case UW_GUARD:
       if (uw_stack->gu.uw_ok)
         break;
-      format(std_error, lit("~a: cannot unwind across foreign stack frames\n"),
+      format(top_stderr, lit("~a: cannot unwind across foreign stack frames\n"),
              prog_string, nao);
       abort();
     default:
@@ -130,11 +130,11 @@ static void uw_unwind_to_exit_point(void)
       val prefix = scat2(prog_string, lit(":"));
 
       flush_stream(std_output);
-      format(std_error, lit("~a unhandled exception of type ~a:\n"),
+      format(top_stderr, lit("~a unhandled exception of type ~a:\n"),
              prefix, sym, nao);
 
       uw_stack = orig_stack;
-      error_trace(sym, args, std_error, prefix);
+      error_trace(sym, args, top_stderr, prefix);
     }
     if (uw_exception_subtype_p(sym, query_error_s) ||
         uw_exception_subtype_p(sym, file_error_s)) {
@@ -718,8 +718,8 @@ val uw_rthrow(val sym, val args)
       --reentry_count;
       if (uw_exception_subtype_p(sym, defr_warning_s))
         uw_defer_warning(args);
-      else if (std_error != 0)
-        format(std_error, lit("~a\n"), car(args), nao);
+      else if (top_stderr != 0)
+        format(top_stderr, lit("~a\n"), car(args), nao);
       if (!opt_compat || opt_compat >= 234) {
         uw_rthrow(continue_s, nil);
         return nil;
@@ -734,7 +734,7 @@ val uw_rthrow(val sym, val args)
       }
     }
 
-    if (std_error == 0) {
+    if (top_stderr == 0) {
       fprintf(stderr, "txr: unhandled exception in early initialization\n");
       abort();
     }
@@ -749,8 +749,8 @@ val uw_rthrow(val sym, val args)
         if (functionp(fun))
           funcall3(fun, sym, args, last_form_evaled);
         else
-          format(std_error, lit("~a: *unhandled-hook* ~s isn't a function\n"),
-                            prog_string, fun, nao);
+          format(top_stderr, lit("~a: *unhandled-hook* ~s isn't a function\n"),
+                 prog_string, fun, nao);
       }
     }
 
-- 
cgit v1.2.3