diff options
author | Andy Wingo <wingo@pobox.com> | 2010-09-30 21:29:20 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-09-30 21:29:20 +0200 |
commit | 542f975e608645122ff41d11f9b782009dadf9dd (patch) | |
tree | 928fba6cdd0efe740d7255c50bba01a471a1eb6f | |
parent | 33002867d7647c595712d0d501c16b8111628b29 (diff) | |
download | guile-542f975e608645122ff41d11f9b782009dadf9dd.tar.gz |
add ,registers
* libguile/frames.h:
* libguile/frames.c (scm_frame_stack_pointer): New function.
* module/system/repl/debug.scm (print-registers): New function, prints
out registers.
* module/system/repl/command.scm (registers): New debugging
meta-command.
(inspect): Not a stack-command, a normal meta-command.
-rw-r--r-- | libguile/frames.c | 11 | ||||
-rw-r--r-- | libguile/frames.h | 1 | ||||
-rw-r--r-- | module/system/repl/command.scm | 12 | ||||
-rw-r--r-- | module/system/repl/debug.scm | 45 |
4 files changed, 35 insertions, 34 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index 2064ef3c1..67ddd1a17 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -213,6 +213,17 @@ SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0, + (SCM frame), + "") +#define FUNC_NAME s_scm_frame_stack_pointer +{ + SCM_VALIDATE_VM_FRAME (1, frame); + + return scm_from_ulong ((unsigned long) SCM_VM_FRAME_SP (frame)); +} +#undef FUNC_NAME + SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0, (SCM frame), "") diff --git a/libguile/frames.h b/libguile/frames.h index 89d0f33bf..3d8a4b27a 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -115,6 +115,7 @@ SCM_API SCM scm_frame_num_locals (SCM frame); SCM_API SCM scm_frame_local_ref (SCM frame, SCM index); SCM_API SCM scm_frame_local_set_x (SCM frame, SCM index, SCM val); SCM_API SCM scm_frame_address (SCM frame); +SCM_API SCM scm_frame_stack_pointer (SCM frame); SCM_API SCM scm_frame_instruction_pointer (SCM frame); SCM_API SCM scm_frame_return_address (SCM frame); SCM_API SCM scm_frame_mv_return_address (SCM frame); diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index d6b6b22f5..4fc79a69c 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -59,7 +59,8 @@ (procedure proc) (locals) (error-message error) (break br bp) (break-at-source break-at bs) (tracepoint tp) - (traps) (delete del) (disable) (enable)) + (traps) (delete del) (disable) (enable) + (registers regs)) (inspect (inspect i) (pretty-print pp)) (system (gc) (statistics stat) (option o) (quit q continue cont)))) @@ -644,13 +645,20 @@ Enable a trap." (error "expected a trap index (a non-negative integer)" idx) (enable-trap! idx))) +(define-stack-command (registers repl) + "registers +Print registers. + +Print the registers of the current frame." + (print-registers cur)) + ;;; ;;; Inspection commands ;;; -(define-stack-command (inspect repl (form)) +(define-meta-command (inspect repl (form)) "inspect EXP Inspect the result(s) of evaluating EXP." (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form)) diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm index 1876d315e..28e7e3060 100644 --- a/module/system/repl/debug.scm +++ b/module/system/repl/debug.scm @@ -31,13 +31,11 @@ #:use-module (system vm program) #:export (<debug> make-debug debug? debug-frames debug-index debug-error-message - print-locals print-frame print-frames frame->module + print-registers print-locals print-frame print-frames frame->module stack->vector narrow-stack->vector)) ;; TODO: ;; -;; Update this TODO list ;) -;; partial meta-commands (,qui -> ,quit) ;; eval expression in context of frame ;; set local variable in frame ;; step until next instruction @@ -46,16 +44,9 @@ ;; step until different source line ;; step until greater source line ;; watch expression -;; break on a function -;; remove breakpoints ;; set printing width -;; display a truncated backtrace -;; go to a frame by index -;; (reuse gdb commands perhaps) -;; disassemble a function ;; disassemble the current function ;; inspect any object -;; hm, trace via reassigning global vars. tricksy. ;; (state associated with vm ?) ;;; @@ -78,6 +69,18 @@ h) ret)) +(define* (print-registers frame #:optional (port (current-output-port)) + #:key (per-line-prefix " ")) + (define (print fmt val) + (display per-line-prefix port) + (run-hook before-print-hook val) + (format port fmt val)) + + (format port "~aRegisters:~%" per-line-prefix) + (print "ip = ~d\n" (frame-instruction-pointer frame)) + (print "sp = #x~x\n" (frame-stack-pointer frame)) + (print "fp = #x~x\n" (frame-address frame))) + (define* (print-locals frame #:optional (port (current-output-port)) #:key (width 72) (per-line-prefix " ")) (let ((bindings (frame-bindings frame))) @@ -161,28 +164,6 @@ (current-module)))) -;; TODO: -;; -;; eval expression in context of frame -;; set local variable in frame -;; step until next instruction -;; step until next function call/return -;; step until return from frame -;; step until different source line -;; step until greater source line -;; watch expression -;; break on a function -;; remove breakpoints -;; set printing width -;; display a truncated backtrace -;; go to a frame by index -;; (reuse gdb commands perhaps) -;; disassemble a function -;; disassemble the current function -;; inspect any object -;; hm, trace via reassigning global vars. tricksy. -;; (state associated with vm ?) - (define (stack->vector stack) (let* ((len (stack-length stack)) (v (make-vector len))) |