Commit 0331b892 authored by Raymond Toy's avatar Raymond Toy
Browse files

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.

o When printing out the source code, bind *print-base* to 10 so that
  the code is printed "naturally".

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*.

o Update
parent 864c24bd
...@@ -2964,10 +2964,11 @@ ...@@ -2964,10 +2964,11 @@
(when stream (when stream
(unless at-block-begin (unless at-block-begin
(terpri stream)) (terpri stream))
(pprint-logical-block (stream nil :per-line-prefix ";;; ") (let ((*print-base* 10))
(format stream "[~D] " (pprint-logical-block (stream nil :per-line-prefix ";;; ")
(di:code-location-form-number loc)) (format stream "[~D] "
(prin1-short form stream)) (di:code-location-form-number loc))
(prin1-short form stream)))
(terpri stream) (terpri stream)
(terpri stream))) (terpri stream)))
t))))) t)))))
...@@ -422,52 +422,39 @@ ...@@ -422,52 +422,39 @@
(princ (disassem:dstate-get-prop dstate 'width) stream) (princ (disassem:dstate-get-prop dstate 'width) stream)
(princ '| PTR | stream)) (princ '| PTR | stream))
(write-char #\[ stream) (write-char #\[ stream)
(let ((firstp t)) (destructuring-bind (&optional base disp index scale) value
(macrolet ((pel ((var val) &body body) (when base
;; Print an element of the address, maybe with (print-addr-reg base stream dstate)
;; a leading separator. (when index
`(let ((,var ,val)) (write-char #\+ stream)))
(when ,var (when index
(unless firstp (print-addr-reg index stream dstate))
(write-char #\+ stream)) (when (and scale (> scale 1))
,@body (write-char #\* stream)
(setq firstp nil))))) (princ scale stream))
(pel (base-reg (first value)) (when (and disp (not (zerop disp)))
(print-addr-reg base-reg stream dstate)) (when (and (or base index))
(pel (index-reg (third value)) (write-char (if (minusp disp) #\- #\+) stream))
(print-addr-reg index-reg stream dstate) (let ((unsigned-offset (if (minusp disp)
(let ((index-scale (fourth value))) (+ #x100000000 disp)
(when (and index-scale (not (= index-scale 1))) disp)))
(write-char #\* stream) (or (nth-value 1
(princ index-scale stream)))) (disassem::note-code-constant-absolute unsigned-offset
(let ((offset (second value))) dstate))
(when (and offset (or firstp (not (zerop offset)))) (disassem:maybe-note-assembler-routine unsigned-offset
(unless (or firstp (minusp offset)) stream
(write-char #\+ stream)) dstate)
(if firstp (let ((offs (- disp disassem::nil-addr)))
(let ((unsigned-offset (if (minusp offset) (when (typep offs 'disassem::offset)
(+ #x100000000 offset) (or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs
offset))) dstate)
(disassem:princ16 unsigned-offset stream) (disassem::maybe-note-static-function offs dstate))))))
(or (nth-value 1 (princ (abs disp) stream)))
(disassem::note-code-constant-absolute unsigned-offset
(disassem:maybe-note-assembler-routine unsigned-offset
(let ((offs (- offset disassem::nil-addr)))
(when (typep offs 'disassem::offset)
(or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs
(disassem::maybe-note-static-function offs dstate))))))
(princ offset stream))))))
(write-char #\] stream)) (write-char #\] stream))
(defun print-imm-data (value stream dstate) (defun print-imm-data (value stream dstate)
(let ((offset (- value disassem::nil-addr))) (let ((offset (- value disassem::nil-addr)))
(if (zerop offset) (princ value stream)
(format stream "#x~X" value)
(format stream "~A" value))
(when (typep offset 'disassem::offset) (when (typep offset 'disassem::offset)
(or (disassem::maybe-note-nil-indexed-object offset dstate) (or (disassem::maybe-note-nil-indexed-object offset dstate)
(let ((unsigned-offset (if (and (numberp value) (minusp value)) (let ((unsigned-offset (if (and (numberp value) (minusp value))
...@@ -603,7 +590,7 @@ ...@@ -603,7 +590,7 @@
(declare (type xmmreg value) (declare (type xmmreg value)
(type stream stream) (type stream stream)
(ignore dstate)) (ignore dstate))
(format stream "XMM~d" value)) (format stream "~A~D" 'xmm value))
(defun print-xmmreg/mem (value stream dstate) (defun print-xmmreg/mem (value stream dstate)
(declare (type (or list xmmreg) value) (declare (type (or list xmmreg) value)
...@@ -21,6 +21,8 @@ New in this release: ...@@ -21,6 +21,8 @@ New in this release:
* Known issues: * Known issues:
* Feature enhancements * Feature enhancements
* The disassembler (on x86) prints correctly for any value of
* Changes * Changes
* ASDF2 updated to version 3.0.2. * ASDF2 updated to version 3.0.2.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment