mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-24 13:30:21 +02:00
* debugger.scm: Use the frame number abstraction which allows for
both forward and backward views of the stack (write-frame-index-short, write-frame-index-long): Use selector `frame-number'; (select-frame-absolute): Use frame-number->index. ("backtrace"): Use builtin backtrace printing. Use (ice-9 debug). Use readline conditionally.
This commit is contained in:
parent
6de43e5fda
commit
8be85ef1fb
1 changed files with 35 additions and 18 deletions
|
@ -17,13 +17,16 @@
|
||||||
;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||||
;;; Boston, MA 02111-1307 USA
|
;;; Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
(define-module (ice-9 debugger))
|
(define-module (ice-9 debugger)
|
||||||
|
:use-module (ice-9 debug))
|
||||||
|
|
||||||
(if (memq 'readline *features*)
|
(if (memq 'readline *features*)
|
||||||
(define-module (ice-9 debugger)
|
(define-module (ice-9 debugger)
|
||||||
:use-module (ice-9 readline)))
|
:use-module (ice-9 readline)))
|
||||||
|
|
||||||
|
|
||||||
|
(define debugger-prompt "debug> ")
|
||||||
|
|
||||||
(define-public (debug)
|
(define-public (debug)
|
||||||
(let ((stack (fluid-ref the-last-stack)))
|
(let ((stack (fluid-ref the-last-stack)))
|
||||||
(if stack
|
(if stack
|
||||||
|
@ -46,11 +49,14 @@
|
||||||
(let loop ((state state))
|
(let loop ((state state))
|
||||||
(loop (read-and-dispatch-command state port)))))
|
(loop (read-and-dispatch-command state port)))))
|
||||||
(lambda arguments
|
(lambda arguments
|
||||||
(set-readline-prompt! scm-repl-prompt)
|
|
||||||
'done)))
|
'done)))
|
||||||
|
|
||||||
(define (read-and-dispatch-command state port)
|
(define (read-and-dispatch-command state port)
|
||||||
(set-readline-prompt! "debug> ")
|
(if (using-readline?)
|
||||||
|
(set-readline-prompt! debugger-prompt)
|
||||||
|
(begin
|
||||||
|
(display debugger-prompt)
|
||||||
|
(force-output)))
|
||||||
(let ((token (read-token port)))
|
(let ((token (read-token port)))
|
||||||
(cond ((eof-object? token)
|
(cond ((eof-object? token)
|
||||||
(throw 'exit-debugger))
|
(throw 'exit-debugger))
|
||||||
|
@ -541,9 +547,18 @@ With a negative argument, print outermost -COUNT frames."
|
||||||
;; Kludge around lack of call-with-values.
|
;; Kludge around lack of call-with-values.
|
||||||
(let ((values
|
(let ((values
|
||||||
(lambda (start end)
|
(lambda (start end)
|
||||||
(do ((index start (+ index 1)))
|
;;(do ((index start (+ index 1)))
|
||||||
((= index end))
|
;; ((= index end))
|
||||||
(write-state-short* stack index)))))
|
;;(write-state-short* stack index))
|
||||||
|
;;
|
||||||
|
;; Use builtin backtrace instead:
|
||||||
|
(display-backtrace stack
|
||||||
|
(current-output-port)
|
||||||
|
(if (memq 'backwards (debug-options))
|
||||||
|
start
|
||||||
|
(- end 1))
|
||||||
|
(- end start))
|
||||||
|
)))
|
||||||
(let ((end (stack-length stack)))
|
(let ((end (stack-length stack)))
|
||||||
(cond ((or (not n-frames) (>= (abs n-frames) end))
|
(cond ((or (not n-frames) (>= (abs n-frames) end))
|
||||||
(values 0 end))
|
(values 0 end))
|
||||||
|
@ -569,7 +584,7 @@ With a negative argument, print outermost -COUNT frames."
|
||||||
(lambda (state)
|
(lambda (state)
|
||||||
(let ((index (state-index state)))
|
(let ((index (state-index state)))
|
||||||
(let ((frame (stack-ref (state-stack state) index)))
|
(let ((frame (stack-ref (state-stack state) index)))
|
||||||
(write-frame-index-long frame index)
|
(write-frame-index-long frame)
|
||||||
(write-frame-args-long frame)))
|
(write-frame-args-long frame)))
|
||||||
state))
|
state))
|
||||||
|
|
||||||
|
@ -581,12 +596,14 @@ With a negative argument, print outermost -COUNT frames."
|
||||||
|
|
||||||
;;;; Command Support
|
;;;; Command Support
|
||||||
|
|
||||||
(define (select-frame-absolute state index)
|
(define (select-frame-absolute state number)
|
||||||
(new-state-index state
|
(new-state-index state
|
||||||
(let ((end (stack-length (state-stack state))))
|
(frame-number->index
|
||||||
(if (>= index end)
|
(let ((end (stack-length (state-stack state))))
|
||||||
(- end 1)
|
(if (>= number end)
|
||||||
index))))
|
(- end 1)
|
||||||
|
number))
|
||||||
|
(state-stack state))))
|
||||||
|
|
||||||
(define (select-frame-relative state delta)
|
(define (select-frame-relative state delta)
|
||||||
(new-state-index state
|
(new-state-index state
|
||||||
|
@ -601,13 +618,13 @@ With a negative argument, print outermost -COUNT frames."
|
||||||
(write-state-short* (state-stack state) (state-index state)))
|
(write-state-short* (state-stack state) (state-index state)))
|
||||||
|
|
||||||
(define (write-state-short* stack index)
|
(define (write-state-short* stack index)
|
||||||
(write-frame-index-short index)
|
(write-frame-index-short stack index)
|
||||||
(write-char #\space)
|
(write-char #\space)
|
||||||
(write-frame-short (stack-ref stack index))
|
(write-frame-short (stack-ref stack index))
|
||||||
(newline))
|
(newline))
|
||||||
|
|
||||||
(define (write-frame-index-short index)
|
(define (write-frame-index-short stack index)
|
||||||
(let ((s (number->string index)))
|
(let ((s (number->string (frame-number (stack-ref stack index)))))
|
||||||
(display s)
|
(display s)
|
||||||
(write-char #\:)
|
(write-char #\:)
|
||||||
(write-chars #\space (- 4 (string-length s)))))
|
(write-chars #\space (- 4 (string-length s)))))
|
||||||
|
@ -645,12 +662,12 @@ With a negative argument, print outermost -COUNT frames."
|
||||||
(define (write-state-long state)
|
(define (write-state-long state)
|
||||||
(let ((index (state-index state)))
|
(let ((index (state-index state)))
|
||||||
(let ((frame (stack-ref (state-stack state) index)))
|
(let ((frame (stack-ref (state-stack state) index)))
|
||||||
(write-frame-index-long frame index)
|
(write-frame-index-long frame)
|
||||||
(write-frame-long frame))))
|
(write-frame-long frame))))
|
||||||
|
|
||||||
(define (write-frame-index-long frame index)
|
(define (write-frame-index-long frame)
|
||||||
(display "Stack frame: ")
|
(display "Stack frame: ")
|
||||||
(write index)
|
(write (frame-number frame))
|
||||||
(if (frame-real? frame)
|
(if (frame-real? frame)
|
||||||
(display " (real)"))
|
(display " (real)"))
|
||||||
(newline))
|
(newline))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue