Fix program-debug-info-addr; remove FIXMEs in disassembler.scm

* module/system/vm/debug.scm (program-debug-info-offset): Rename from
  program-debug-info-addr to reflect reality.
  (program-debug-info-addr): New function.

* module/system/vm/disassembler.scm (disassembler): Remove FIXMEs.
  (disassemble-program): Rely on the RTL program to print its name.

2 files changed, 14 insertions, 25 deletions

diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index bd8a0d64a..58cb9775e 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -35,6 +35,7 @@
             program-debug-info-name
             program-debug-info-context
             program-debug-info-image
+            program-debug-info-offset
             program-debug-info-addr
             program-debug-info-u32-offset
             program-debug-info-u32-offset-end
@@ -55,28 +56,33 @@
   (+ (debug-context-base context) (* offset 4)))
 
 (define-record-type <program-debug-info>
-  (make-program-debug-info context name addr size)
+  (make-program-debug-info context name offset size)
   program-debug-info?
   (context program-debug-info-context)
   (name program-debug-info-name)
-  (addr program-debug-info-addr)
+  (offset program-debug-info-offset)
   (size program-debug-info-size))
 
+(define (program-debug-info-addr pdi)
+  (+ (program-debug-info-offset pdi)
+     (debug-context-text-base (program-debug-info-context pdi))
+     (debug-context-base (program-debug-info-context pdi))))
+
 (define (program-debug-info-image pdi)
   (debug-context-image (program-debug-info-context pdi)))
 
 (define (program-debug-info-u32-offset pdi)
-  ;; ADDR is in bytes from the beginning of the text section.  TEXT-BASE
-  ;; is in bytes from the beginning of the image.  Return ADDR as a u32
+  ;; OFFSET is in bytes from the beginning of the text section.  TEXT-BASE
+  ;; is in bytes from the beginning of the image.  Return OFFSET as a u32
   ;; index from the start of the image.
-  (/ (+ (program-debug-info-addr pdi)
+  (/ (+ (program-debug-info-offset pdi)
         (debug-context-text-base (program-debug-info-context pdi)))
      4))
 
 (define (program-debug-info-u32-offset-end pdi)
   ;; Return the end position as a u32 index from the start of the image.
   (/ (+ (program-debug-info-size pdi)
-        (program-debug-info-addr pdi)
+        (program-debug-info-offset pdi)
         (debug-context-text-base (program-debug-info-context pdi)))
      4))
 
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 1db44aa7c..7e949e024 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -73,10 +73,8 @@
           ((U8_U24)
            #'((ash word -8)))
           ((U8_L24)
-           ;; Fixme: translate back to label
            #'((unpack-s24 (ash word -8))))
           ((U8_R24)
-           ;; FIXME: parse rest instructions correctly
            #'(#:rest (ash word -8)))
           ((U8_U8_I16)
            #'((logand (ash word -8) #xff)
@@ -100,15 +98,12 @@
            #'((logand word #xff)
               (ash word -8)))
           ((U8_L24)
-           ;; Fixme: translate back to label
            #'((logand word #xff)
               (unpack-s24 (ash word -8))))
           ((U8_R24)
-           ;; FIXME: parse rest instructions correctly
            #'((logand word #xff)
               #:rest (ash word -8)))
           ((U8_U8_I16)
-           ;; FIXME: immediates
            #'((logand word #xff)
               (logand (ash word -8) #xff)
               (ash word -16)))
@@ -124,25 +119,18 @@
           ((U32)
            #'(word))
           ((I32)
-           ;; FIXME: immediates
            #'(word))
           ((A32)
-           ;; FIXME: long immediates
            #'(word))
           ((B32)
-           ;; FIXME: long immediates
            #'(word))
           ((N32)
-           ;; FIXME: non-immediate
            #'((unpack-s32 word)))
           ((S32)
-           ;; FIXME: indirect access
            #'((unpack-s32 word)))
           ((L32)
-           ;; FIXME: offset
            #'((unpack-s32 word)))
           ((LO32)
-           ;; FIXME: offset
            #'((unpack-s32 word)))
           ((X8_U24)
            #'((ash word -8)))
@@ -150,17 +138,13 @@
            #'((logand (ash word -8) #xfff)
               (ash word -20)))
           ((X8_R24)
-           ;; FIXME: rest
            #'(#:rest (ash word -8)))
           ((X8_L24)
-           ;; FIXME: label
            #'((unpack-s24 (ash word -8))))
           ((U1_X7_L24)
-           ;; FIXME: label
            #'((logand word #x1)
               (unpack-s24 (ash word -8))))
           ((U1_U7_L24)
-           ;; FIXME: label
            #'((logand word #x1)
               (logand (ash word -1) #x7f)
               (unpack-s24 (ash word -8))))
@@ -345,9 +329,8 @@
   (cond
    ((find-program-debug-info #:program program)
     => (lambda (pdi)
-         ;; FIXME: RTL programs should print with their names.
-         (format port "Disassembly of ~A at ~S:\n\n"
-                 (program-debug-info-name pdi) program)
+         (format port "Disassembly of ~S at #x~X:\n\n" program
+                 (program-debug-info-addr pdi))
          (disassemble-buffer port
                              (program-debug-info-image pdi)
                              (program-debug-info-u32-offset pdi)