From dfc39c2f29e19e56e123a8826a9e3904681b3f61 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 26 Oct 2016 06:56:04 -0700
Subject: Let guard frames optionally pass through unwinding.

We have a bug in that when an exception occurs in a context
called from obj_print, the guard for stopping continuation
captures across obj_print also unintentially blocks the
unwinding. Let's make the unwinding blockage optional

* unwind.c (uw_unwind_to_exit_point): If a UW_GUARD is
encountered, do not abort if the uw_ok flag is set;
keep unwinding.
(uw_push_guard): New uw_ok argument, initializes the
uw_ok member of a guard frame.

* unwind.h (struct uw_guard): New struct type.
(union uw_frame): New member gu of type struct uw_guard.
(uw_push_guard): Declaration updated.

* ftw.c (ftw_callback): Pass zero as new uw_push_guard
argument: no unwinding across the POSIX library function ftw.

* glob.c (errfunc_thunk): Likewise, no unwinding across
the library function glob.

* lib.c (obj_print): Pass 1 as new uw_push_guard argument:
continuations can't be captured, but unwinding is okay.
---
 ftw.c    | 2 +-
 glob.c   | 2 +-
 lib.c    | 2 +-
 unwind.c | 5 ++++-
 unwind.h | 9 ++++++++-
 5 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/ftw.c b/ftw.c
index 2c5a4a29..acc0ed16 100644
--- a/ftw.c
+++ b/ftw.c
@@ -52,7 +52,7 @@ static int ftw_callback(const char *c_path, const struct stat *c_sb,
   int c_result = 1;
   uw_frame_t cont_guard;
 
-  uw_push_guard(&cont_guard);
+  uw_push_guard(&cont_guard, 0);
 
   uw_simple_catch_begin;
 
diff --git a/glob.c b/glob.c
index 4ce1e2f8..21f2bb0c 100644
--- a/glob.c
+++ b/glob.c
@@ -47,7 +47,7 @@ static int errfunc_thunk(const char *errpath, int errcode)
   val result = t;
   uw_frame_t cont_guard;
 
-  uw_push_guard(&cont_guard);
+  uw_push_guard(&cont_guard, 0);
 
   uw_simple_catch_begin;
 
diff --git a/lib.c b/lib.c
index fffe2970..f7b75809 100644
--- a/lib.c
+++ b/lib.c
@@ -9497,7 +9497,7 @@ val obj_print(val obj, val out, val pretty)
   struct strm_ctx *volatile ctx = ctx_orig, ctx_struct;
   uw_frame_t cont_guard;
 
-  uw_push_guard(&cont_guard);
+  uw_push_guard(&cont_guard, 1);
 
   uw_simple_catch_begin;
 
diff --git a/unwind.c b/unwind.c
index 104bb11e..6fc2720e 100644
--- a/unwind.c
+++ b/unwind.c
@@ -95,6 +95,8 @@ static void uw_unwind_to_exit_point(void)
       uw_env_stack = uw_env_stack->ev.up_env;
       break;
     case UW_GUARD:
+      if (uw_stack->gu.uw_ok)
+        break;
       format(std_error, lit("~a: cannot unwind across foreign stack frames\n"),
              prog_string, nao);
       abort();
@@ -234,11 +236,12 @@ val uw_set_match_context(val context)
   return context;
 }
 
-void uw_push_guard(uw_frame_t *fr)
+void uw_push_guard(uw_frame_t *fr, int uw_ok)
 {
   memset(fr, 0, sizeof *fr);
   fr->uw.type = UW_GUARD;
   fr->uw.up = uw_stack;
+  fr->gu.uw_ok = uw_ok;
   uw_stack = fr;
 }
 
diff --git a/unwind.h b/unwind.h
index 7177f0b1..20e3c987 100644
--- a/unwind.h
+++ b/unwind.h
@@ -79,6 +79,12 @@ struct uw_cont_copy {
   void (*copy)(mem_t *ptr, int parent);
 };
 
+struct uw_guard {
+  uw_frame_t *up;
+  uw_frtype_t type;
+  int uw_ok;
+};
+
 struct uw_debug {
   uw_frame_t *up;
   uw_frtype_t type;
@@ -98,6 +104,7 @@ union uw_frame {
   struct uw_catch ca;
   struct uw_handler ha;
   struct uw_cont_copy cp;
+  struct uw_guard gu;
   struct uw_debug db;
 };
 
@@ -124,7 +131,7 @@ noreturn val uw_errorfv(val fmt, struct args *args);
 val uw_register_subtype(val sub, val super);
 val uw_exception_subtype_p(val sub, val sup);
 void uw_continue(uw_frame_t *target);
-void uw_push_guard(uw_frame_t *);
+void uw_push_guard(uw_frame_t *, int uw_ok);
 void uw_push_debug(uw_frame_t *, val func, struct args *,
                    val ub_p_a_pairs, val env, val data,
                    val line, val chr);
-- 
cgit v1.2.3