diff options
author | Andy Wingo <wingo@pobox.com> | 2009-12-24 14:20:41 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-12-24 14:20:41 +0100 |
commit | d7a4096d251933a21325739fcd32129b073c33ce (patch) | |
tree | ee1797af545c22ba5b59f8f9a5c3a77b94a62a2e | |
parent | f6fe5fe26b7b64c2d194b1dd27b1bd038e8fa70c (diff) | |
download | guile-d7a4096d251933a21325739fcd32129b073c33ce.tar.gz |
implement up, down, frame, and bindings in the repl
* module/system/vm/debug.scm (debugger-repl): Implement up, down, frame,
and bindings using the new command infrastructure.
-rw-r--r-- | module/system/vm/debug.scm | 122 |
1 files changed, 79 insertions, 43 deletions
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index f416abd73..462af5094 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -100,6 +100,7 @@ (define (debugger-repl db frame) (let ((top frame) + (cur frame) (index 0) (level (debugger-level db))) (define (frame-index frame) @@ -107,6 +108,18 @@ (if (= (frame-return-address frame) (frame-return-address walk)) idx (lp (1+ idx) (frame-previous walk))))) + (define (frame-at-index idx) + (let lp ((idx idx) (walk top)) + (cond + ((not walk) #f) + ((zero? idx) walk) + (else (lp (1+ idx) (frame-previous walk)))))) + (define (show-frame) +; #2 0x009600e0 in do_std_select (args=0xbfffd9e0) at threads.c:1668 +; 1668 select (select_args->nfds, + (let ((p (frame-procedure cur))) + (format #t "#~2a 0x~8,'0x in ~s~%" index (frame-instruction-pointer cur) + (cons (or (procedure-name p) p) (frame-arguments cur))))) (define-syntax define-command (syntax-rules () @@ -138,42 +151,66 @@ (define-command ((commands backtrace bt) #:optional count) "Print a backtrace of all stack frames, or innermost COUNT frames." - (display-backtrace (make-stack frame) (current-output-port))) + (display-backtrace (make-stack top) (current-output-port) #f count)) + + (define-command ((commands up) #:optional (count 1)) + "Select and print stack frames that called this one. +An argument says how many frames up to go" + (if (or (not (integer? count)) (<= count 0)) + (format #t "Invalid argument to `up': expected a positive integer for COUNT.~%") + (let lp ((n count)) + (cond + ((zero? n) (show-frame)) + ((frame-previous cur) + => (lambda (new) + (set! cur new) + (set! index (1+ index)) + (lp (1- n)))) + ((= n count) + (format #t "Already at outermost frame.\n")) + (else + (format #t "Reached outermost frame after walking ~a frames.\n" + (- count n)) + (show-frame)))))) + + (define-command ((commands down) #:optional (count 1)) + "Select and print stack frames called by this one. +An argument says how many frames down to go" + (cond + ((or (not (integer? count)) (<= count 0)) + (format #t "Invalid argument to `down': expected a positive integer for COUNT.~%")) + ((= index 0) + (format #t "Already at innermost frame.~%")) + (else + (set! index (max (- index count) 0)) + (set! cur (frame-at-index index)) + (show-frame)))) + + (define-command ((commands frame f) #:optional idx) + "Show the selected frame. +With an argument, select a frame by index, then show it." + (cond + (idx + (cond + ((or (not (integer? idx)) (< idx 0)) + (format #t "Invalid argument to `frame': expected a non-negative integer for IDX.~%")) + ((frame-at-index idx) + => (lambda (f) + (set! cur f) + (set! index idx) + (show-frame))) + (else + (format #t "No such frame.~%")))) + (else (show-frame)))) + + (define-command ((commands bindings)) + "Show some information about locally-bound variables in the selected frame." + (format #t "~a\n" (frame-bindings cur))) (define-command ((commands quit q continue cont c)) "Quit the debugger and let the program continue executing." (throw 'quit)) - #; - (case cmd - ((bt) - (display-backtrace (make-stack frame) (current-output-port))) - ((bindings) - (format #t "~a\n" (frame-bindings frame))) - ((frame f) - (format #t "~s\n" frame)) - ((up) - (let ((prev (frame-previous frame))) - (if prev - (begin - (set! index (1+ index)) - (set! frame prev) - (format #t "~s\n" frame)) - (format #t "Already at outermost frame.\n")))) - ((down) - (if (zero? index) - (format #t "Already at innermost frame.\n") - (begin - (set! frame (let lp ((n (1- index)) (frame top)) - (if (zero? n) - frame - (lp (1- n) (frame-previous top))))) - (format #t "~s\n" frame)))) - ((help ?) - (format #t "Type `c' to continue.\n")) - (else - (format #t "Unknown command: ~A\n" cmd))) - (define-command ((commands help h ?) #:optional cmd) "Show this help message." (let ((rhash (reverse-hashq (module-obarray commands)))) @@ -217,9 +254,10 @@ (lambda () (apply (variable-ref var) args)) (lambda () - (format (current-error-port) "Invalid arguments to ~a~%" - (procedure-name proc)) - (help cmd)))))) + (format (current-error-port) + "Invalid arguments to ~a. Try `help ~a'.~%" + (procedure-name proc) (procedure-name proc))))))) + #; ((and (integer? cmd) (exact? cmd)) (nth cmd)) @@ -234,19 +272,17 @@ (catch 'quit (lambda () (let loop () - (call-with-values - (lambda () - (apply - handle - (save-module-excursion - (lambda () - (set-current-module commands) - (read-args prompt))))) - print*) + (apply + handle + (save-module-excursion + (lambda () + (set-current-module commands) + (read-args prompt)))) (loop))) (lambda (k . args) (apply values args)))))) + ;; things this debugger should do: ;; ;; eval expression in context of frame |