diff options
author | Andy Wingo <wingo@pobox.com> | 2016-04-01 21:30:13 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-04-04 16:30:52 +0200 |
commit | 737e62f4b5a9ef771bd40aab793942ba409cfe8a (patch) | |
tree | ce73166e9f15ca97f2c0061bea4afb71b69e4cb4 /module/system/repl/debug.scm | |
parent | 43a038f6e12cc4615df3f4fb9e6904bd819a2928 (diff) | |
download | guile-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.scm | 32 |
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 |