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