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.

diff --git a/libguile/frames.c b/libguile/frames.c
index 2064ef3..67ddd1a 100644 (file)
--- 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 89d0f33..3d8a4b2 100644 (file)
--- 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 d6b6b22..4fc79a6 100644 (file)
--- 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))
+
 
 \f
 ;;;
 ;;; 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 1876d31..28e7e30 100644 (file)
--- 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)))