summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/frames.c11
-rw-r--r--libguile/frames.h1
-rw-r--r--module/system/repl/command.scm12
-rw-r--r--module/system/repl/debug.scm45
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)))