From 6bb45477014c490a6f6d9fac3a73020ce284145f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 20 Dec 2016 07:57:46 -0800
Subject: New function: find-frames.

* unwind.c (uw_find_frames_impl): New static function, made
from uw_find_frame.
(uw_find_frame): Reduced to wrapper around
uw_find_frames_impl.
(uw_find_frames): New function.
(uw_late_init): Register find-frames intrinsic.

* unwind.h (uw_find_frames): Declared.

* txr.1: Documented.
---
 txr.1    | 11 ++++++++++-
 unwind.c | 20 +++++++++++++++++---
 unwind.h |  1 +
 3 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/txr.1 b/txr.1
index 73129a1a..3409fc91 100644
--- a/txr.1
+++ b/txr.1
@@ -33019,9 +33019,10 @@ structure may be passed as an argument to the
 .code invoke-catch
 function.
 
-.coNP Function @ find-frame
+.coNP Functions @ find-frame and @ find-frames
 .synb
 .mets (find-frame >> [ exception-symbol <> [ frame-type ]])
+.mets (find-frames >> [ exception-symbol <> [ frame-type ]])
 .syne
 .desc
 The
@@ -33070,6 +33071,14 @@ is called with no arguments at all it finds the innermost catch frame,
 if any exists, or else returns
 .codn nil .
 
+The
+.code find-frames
+function is similar to
+.code find-frame
+except that it returns all matching frames, ordered from the inner-most nesting
+level to the outer-most nesting. If called with no arguments, it returns a
+list of the catch frames.
+
 .coNP Function @ invoke-catch
 .synb
 .mets (invoke-catch < catch-frame < symbol << argument *)
diff --git a/unwind.c b/unwind.c
index 056cdb50..5a880acc 100644
--- a/unwind.c
+++ b/unwind.c
@@ -335,10 +335,11 @@ val uw_get_frames(void)
   return out;
 }
 
-val uw_find_frame(val extype, val frtype)
+static val uw_find_frames_impl(val extype, val frtype, val just_one)
 {
   uw_frame_t *ex;
   uw_frtype_t et;
+  list_collect_decl (out, ptail);
 
   extype = default_bool_arg(extype);
   frtype = default_arg_strict(frtype, catch_frame_type);
@@ -373,12 +374,24 @@ val uw_find_frame(val extype, val frtype)
           slotset(fr, jump_s, cptr(coerce(mem_t *, ex)));
         else
           slotset(fr, fun_s, ex->ha.fun);
-        return fr;
+        if (just_one)
+          return fr;
+        ptail = list_collect(ptail, fr);
       }
     }
   }
 
-  return nil;
+  return out;
+}
+
+val uw_find_frame(val extype, val frtype)
+{
+  return uw_find_frames_impl(extype, frtype, t);
+}
+
+val uw_find_frames(val extype, val frtype)
+{
+  return uw_find_frames_impl(extype, frtype, nil);
 }
 
 val uw_invoke_catch(val catch_frame, val sym, struct args *args)
@@ -987,6 +1000,7 @@ void uw_late_init(void)
   reg_fun(intern(lit("exception-subtype-map"), user_package), func_n0(exception_subtype_map));
   reg_fun(intern(lit("get-frames"), user_package), func_n0(uw_get_frames));
   reg_fun(intern(lit("find-frame"), user_package), func_n2o(uw_find_frame, 0));
+  reg_fun(intern(lit("find-frames"), user_package), func_n2o(uw_find_frames, 0));
   reg_fun(intern(lit("invoke-catch"), user_package),
           func_n2v(uw_invoke_catch));
   reg_fun(sys_capture_cont_s = intern(lit("capture-cont"), system_package),
diff --git a/unwind.h b/unwind.h
index ea8af20b..4ca52228 100644
--- a/unwind.h
+++ b/unwind.h
@@ -142,6 +142,7 @@ uw_frame_t *uw_current_frame(void);
 uw_frame_t *uw_current_exit_point(void);
 val uw_get_frames(void);
 val uw_find_frame(val extype, val frtype);
+val uw_find_frames(val extype, val frtype);
 val uw_invoke_catch(val catch_frame, val sym, struct args *);
 val uw_muffle_warning(val exc, struct args *);
 val uw_capture_cont(val tag, val fun, val ctx_form);
-- 
cgit v1.2.3