[Guile-commits] 12/41: ,registers doesn't use frame-procedure

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 2d0214a9b741083ca89d587016c86ad7b4c4bf1b
Author: Andy Wingo <wi...@pobox.com>
Date:   Fri Nov 27 12:53:34 2015 +0100

    ,registers doesn't use frame-procedure
    
    * module/system/repl/debug.scm (print-registers): Avoid frame-procedure,
      and be more useful and print an offset in units of 4 bytes.
---
 module/system/repl/debug.scm |   14 ++++++++------
 1 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 9516af6..e148d44 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -24,6 +24,7 @@
   #:use-module (system base language)
   #:use-module (system vm vm)
   #:use-module (system vm frame)
+  #:use-module (system vm debug)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 format)
@@ -94,12 +95,13 @@
     (format port fmt val))
   
   (format port "~aRegisters:~%" per-line-prefix)
-  (print "ip = #x~x" (frame-instruction-pointer frame))
-  (when (program? (frame-procedure frame))
-    (let ((code (program-code (frame-procedure frame))))
-      (format port " (#x~x~@d)" code
-              (- (frame-instruction-pointer frame) code))))
-  (newline port)
+  (let ((ip (frame-instruction-pointer frame)))
+    (print "ip = #x~x" ip)
+    (let ((info (find-program-debug-info ip)))
+      (when info
+        (let ((addr (program-debug-info-addr info)))
+          (format port " (#x~x + ~d * 4)" addr (/ (- ip addr) 4)))))
+    (newline port))
   (print "sp = ~a\n" (frame-stack-pointer frame))
   (print "fp = ~a\n" (frame-address frame)))