Make some disassembler parameters effectual.

In the context of changing the treatment of prefix instructions in the
disassembler I came across somewhat broken code to parametrize it.
This might as well be repaired, so:

Correct the calculation of the DSTATE's ARGUMENT-COLUMN which is
intended to set a minimal field width for the opcode column. It needs
to take *DISASSEM-INST-COLUMN-WIDTH* and a few more column separators
into account. So as not to confuse users, restore the previous behaviour
by setting *DISASSEM-OPCODE-COLUMN-WIDTH* to 0.

Don't emit instruction bytes when *DISASSEM-INST-COLUMN-WIDTH* is 0.

Whitespace correction in ALIGNMENT-HOOK.

Playing with these two parameters allows to select different disassembly
formats (example from x86-64):

Current:

;      E11: L7:   4881FB17001020   CMP RBX, 537919511
;      E18:       0F8480000000     JEQ L13

(setf SB-DISASSEM::*DISASSEM-INST-COLUMN-WIDTH* 0)

;      E11: L7:   CMP RBX, 537919511
;      E18:       JEQ L13

(setf SB-DISASSEM:*DISASSEM-OPCODE-COLUMN-WIDTH* 8)

;      E11: L7:   CMP     RBX, 537919511
;      E18:       JEQ     L13

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 1b9669a..22e3f9a 100644 (file)
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -46,7 +46,7 @@
 ;;; the width of the column in which instruction-names are printed. A
 ;;; value of zero gives the effect of not aligning the arguments at
 ;;; all.
-(defvar *disassem-opcode-column-width* 6)
+(defvar *disassem-opcode-column-width* 0)
 (declaim (type text-width *disassem-opcode-column-width*))
 
 ;;; the width of the column in which instruction-bytes are printed. A

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 1914bdc..2ba6998 100644 (file)
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -422,8 +422,8 @@
         (format stream "~A~Vt~W~%" '.align
                 (dstate-argument-column dstate)
                 alignment))
-      (incf(dstate-next-offs dstate)
-           (- (align location alignment) location)))
+      (incf (dstate-next-offs dstate)
+            (- (align location alignment) location)))
     nil))
 
 (defun rewind-current-segment (dstate segment)
@@ -478,9 +478,10 @@
 (defun pad-inst-column (stream n-bytes)
   (declare (type stream stream)
            (type text-width n-bytes))
-  (dotimes (i (- *disassem-inst-column-width* (* 2 n-bytes)))
-    (write-char #\space stream))
-  (write-char #\space stream))
+  (when (> *disassem-inst-column-width* 0)
+    (dotimes (i (- *disassem-inst-column-width* (* 2 n-bytes)))
+      (write-char #\space stream))
+    (write-char #\space stream)))
 
 (defun handle-bogus-instruction (stream dstate prefix-len)
   (let ((alignment (dstate-alignment dstate)))
@@ -786,12 +787,13 @@
 
 ;;; Print NUM instruction bytes to STREAM as hex values.
 (defun print-inst (num stream dstate &key (offset 0) (trailing-space t))
-  (let ((sap (dstate-segment-sap dstate))
-        (start-offs (+ offset (dstate-cur-offs dstate))))
-    (dotimes (offs num)
-      (format stream "~2,'0x" (sb!sys:sap-ref-8 sap (+ offs start-offs))))
-    (when trailing-space
-      (pad-inst-column stream num))))
+  (when (> *disassem-inst-column-width* 0)
+    (let ((sap (dstate-segment-sap dstate))
+          (start-offs (+ offset (dstate-cur-offs dstate))))
+      (dotimes (offs num)
+        (format stream "~2,'0x" (sb!sys:sap-ref-8 sap (+ offs start-offs))))
+      (when trailing-space
+        (pad-inst-column stream num)))))
 
 ;;; Disassemble NUM bytes to STREAM as simple `BYTE' instructions.
 (defun print-bytes (num stream dstate)
@@ -839,10 +841,13 @@
 (defun make-dstate (&optional (fun-hooks *default-dstate-hooks*))
   (let ((alignment *disassem-inst-alignment-bytes*)
         (arg-column
-         (+ (or *disassem-opcode-column-width* 0)
+         (+ 2
             *disassem-location-column-width*
             1
-            label-column-width)))
+            label-column-width
+            *disassem-inst-column-width*
+            (if (zerop *disassem-inst-column-width*) 0 1)
+            *disassem-opcode-column-width*)))
 
     (when (> alignment 1)
       (push #'alignment-hook fun-hooks))