[Guile-commits] 01/18: Fix frame->stack-vector when no stack is active

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit 737e62f4b5a9ef771bd40aab793942ba409cfe8a
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 1 21:30:13 2016 +0200

    Fix frame->stack-vector when no stack is active
    
    * module/system/repl/debug.scm (frame->stack-vector): Handle the case
      where there is no active stack.
---
 module/system/repl/debug.scm |   32 +++++++++++++++++---------------
 1 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 274ebdd..55062d7 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -25,9 +25,10 @@
   #:use-module (system vm vm)
   #:use-module (system vm frame)
   #:use-module (system vm debug)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 pretty-print)
-  #:use-module (ice-9 format)
   #:use-module ((system vm inspect) #:select ((inspect . %inspect)))
   #:use-module (system vm program)
   #:export (<debug>
@@ -181,20 +182,21 @@
         #()))) ; ? 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))))
+  (let ((stack (make-stack frame)))
+    (match (fluid-ref %stacks)
+      (((stack-tag . prompt-tag) . _)
+       (narrow-stack->vector
+        stack
+        ;; Take the stack from the given frame, cutting 0 frames.
+        0
+        ;; Narrow the end of the stack to the most recent start-stack.
+        prompt-tag
+        ;; And one more frame, because %start-stack invoking the
+        ;; start-stack thunk has its own frame too.
+        0 (and prompt-tag 1)))
+      (_
+       ;; Otherwise take the whole stack.
+       (stack->vector stack)))))
 
 ;; (define (debug)
 ;;   (run-debugger