From 586aff5a27fc880b8f80e20352e3bad41c75616c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 5 Oct 2010 21:49:13 +0200
Subject: [PATCH] (system repl debug): add frame->stack-vector

* module/system/repl/debug.scm (frame->stack-vector): New public
  function.
---
 module/system/repl/debug.scm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 0e491b5db..da42a37fe 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -32,7 +32,8 @@
   #:export (<debug>
             make-debug debug? debug-frames debug-index debug-error-message
             print-registers print-locals print-frame print-frames frame->module
-            stack->vector narrow-stack->vector))
+            stack->vector narrow-stack->vector
+            frame->stack-vector))
 
 ;; TODO:
 ;;
@@ -181,6 +182,21 @@
         (stack->vector narrowed)
         #()))) ; ? Can be the case for a tail-call to `throw' tho
 
+(define (frame->stack-vector frame)
+  (let ((tag (and (pair? (fluid-ref %stacks))
+                  (cdar (fluid-ref %stacks)))))
+    (narrow-stack->vector
+     (make-stack frame)
+     ;; Take the stack from the given frame, cutting 0
+     ;; frames.
+     0
+     ;; Narrow the end of the stack to the most recent
+     ;; start-stack.
+     tag
+     ;; And one more frame, because %start-stack
+     ;; invoking the start-stack thunk has its own frame
+     ;; too.
+     0 (and tag 1))))
 
 ;; (define (debug)
 ;;   (run-debugger
-- 
2.20.1