From 0331b89234436da149eb5b142e206ae5af2d9c7b Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Wed, 21 Aug 2013 20:16:01 -0700
Subject: [PATCH] Allow disasembler to work for any value of *print-base*.

With these changes, you can bind *print-base* to 16 and *print-case*
to :downcase to get correctly printed disassembly in lower case with
all numerical values in hex.  If you want the radix marker as well,
bind *print-radix* to T; the disassembly is still correct.

src/compiler/disassem.lisp:
o When printing out the source code, bind *print-base* to 10 so that
  the code is printed "naturally".

src/compiler/x86/insts.lisp:
o Use Carl's much cleaned-up print-mem-access
o Update print-imm-data to use princ for all values, removing the
  special casing for NIL
o When printing out xmm registers, honor *print-case*.

src/general-info/release-20e.txt:
o Update
---
 src/compiler/disassem.lisp       |  9 ++--
 src/compiler/x86/insts.lisp      | 73 +++++++++++++-------------------
 src/general-info/release-20e.txt |  2 +
 3 files changed, 37 insertions(+), 47 deletions(-)

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 13f6b3554..a23659249 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -2964,10 +2964,11 @@
 				(when stream
 				  (unless at-block-begin
 				    (terpri stream))
-				  (pprint-logical-block (stream nil :per-line-prefix ";;; ")
-				    (format stream "[~D] "
-					    (di:code-location-form-number loc))
-				    (prin1-short form stream))
+				  (let ((*print-base* 10))
+				    (pprint-logical-block (stream nil :per-line-prefix ";;; ")
+				      (format stream "[~D] "
+					      (di:code-location-form-number loc))
+				      (prin1-short form stream)))
 				  (terpri stream)
 				  (terpri stream)))
 			    t)))))
diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 2417c04a0..048b9ec4d 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -422,52 +422,39 @@
     (princ (disassem:dstate-get-prop dstate 'width) stream)
     (princ '| PTR | stream))
   (write-char #\[ stream)
-  (let ((firstp t))
-    (macrolet ((pel ((var val) &body body)
-		 ;; Print an element of the address, maybe with
-		 ;; a leading separator.
-		 `(let ((,var ,val))
-		    (when ,var
-		      (unless firstp
-			(write-char #\+ stream))
-		      ,@body
-		      (setq firstp nil)))))
-      (pel (base-reg (first value))
-	(print-addr-reg base-reg stream dstate))
-      (pel (index-reg (third value))
-	(print-addr-reg index-reg stream dstate)
-	(let ((index-scale (fourth value)))
-	  (when (and index-scale (not (= index-scale 1)))
-	    (write-char #\* stream)
-	    (princ index-scale stream))))
-      (let ((offset (second value)))
-	(when (and offset (or firstp (not (zerop offset))))
-	  (unless (or firstp (minusp offset))
-	    (write-char #\+ stream))
-	  (if firstp
-	      (let ((unsigned-offset (if (minusp offset)
-					 (+ #x100000000 offset)
-					 offset)))
-		(disassem:princ16 unsigned-offset stream)
-		(or (nth-value 1
-			       (disassem::note-code-constant-absolute unsigned-offset
-								      dstate))
-		    (disassem:maybe-note-assembler-routine unsigned-offset
-							   stream
-							   dstate)
-		    (let ((offs (- offset disassem::nil-addr)))
-		      (when (typep offs 'disassem::offset)
-			(or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs
-									      dstate)
-			    (disassem::maybe-note-static-function offs dstate))))))
-	      (princ offset stream))))))
+  (destructuring-bind (&optional base disp index scale) value
+    (when base
+      (print-addr-reg base stream dstate)
+      (when index
+	(write-char #\+ stream)))
+    (when index
+      (print-addr-reg index stream dstate))
+    (when (and scale (> scale 1))
+      (write-char #\* stream)
+      (princ scale stream))
+    (when (and disp (not (zerop disp)))
+      (when (and (or base index))
+	(write-char (if (minusp disp) #\- #\+) stream))
+      (let ((unsigned-offset (if (minusp disp)
+				 (+ #x100000000 disp)
+				 disp)))
+	(or (nth-value 1
+		       (disassem::note-code-constant-absolute unsigned-offset
+							      dstate))
+	    (disassem:maybe-note-assembler-routine unsigned-offset
+						   stream
+						   dstate)
+	    (let ((offs (- disp disassem::nil-addr)))
+	      (when (typep offs 'disassem::offset)
+		(or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs
+								      dstate)
+		    (disassem::maybe-note-static-function offs dstate))))))
+      (princ (abs disp) stream)))
   (write-char #\] stream))
 
 (defun print-imm-data (value stream dstate)
   (let ((offset (- value disassem::nil-addr)))
-    (if (zerop offset)
-	(format stream "#x~X" value)
-	(format stream "~A" value))
+    (princ value stream)
     (when (typep offset 'disassem::offset)
       (or (disassem::maybe-note-nil-indexed-object offset dstate)
 	  (let ((unsigned-offset (if (and (numberp value) (minusp value))
@@ -603,7 +590,7 @@
   (declare (type xmmreg value)
            (type stream stream)
            (ignore dstate))
-  (format stream "XMM~d" value))
+  (format stream "~A~D" 'xmm value))
 
 (defun print-xmmreg/mem (value stream dstate)
   (declare (type (or list xmmreg) value)
diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt
index 6c4fd1aad..9d91bcce0 100644
--- a/src/general-info/release-20e.txt
+++ b/src/general-info/release-20e.txt
@@ -21,6 +21,8 @@ New in this release:
   * Known issues:
 
   * Feature enhancements
+    * The disassembler (on x86) prints correctly for any value of
+      *print-base*.
  
   * Changes
     * ASDF2 updated to version 3.0.2.
-- 
GitLab