summaryrefslogtreecommitdiff
path: root/module/system/repl/debug.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-04-01 21:30:13 +0200
committerAndy Wingo <wingo@pobox.com>2016-04-04 16:30:52 +0200
commit737e62f4b5a9ef771bd40aab793942ba409cfe8a (patch)
treece73166e9f15ca97f2c0061bea4afb71b69e4cb4 /module/system/repl/debug.scm
parent43a038f6e12cc4615df3f4fb9e6904bd819a2928 (diff)
downloadguile-737e62f4b5a9ef771bd40aab793942ba409cfe8a.tar.gz
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.
Diffstat (limited to 'module/system/repl/debug.scm')
-rw-r--r--module/system/repl/debug.scm32
1 files changed, 17 insertions, 15 deletions
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 274ebdd00..55062d783 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