1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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.
This commit is contained in:
Andy Wingo 2010-09-30 21:29:20 +02:00
parent 33002867d7
commit 542f975e60
4 changed files with 35 additions and 34 deletions

View file

@ -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),
"")

View file

@ -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);

View file

@ -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))

View file

@ -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)))