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 @@
(when stream
(unless at-block-begin
(terpri 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))
(prin1-short form stream)))
(terpri stream)
(terpri stream)))
......@@ -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))
(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)))
(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 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)
(disassem:princ16 unsigned-offset 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)
(or (nth-value 1
(disassem::note-code-constant-absolute unsigned-offset
(disassem:maybe-note-assembler-routine unsigned-offset
(let ((offs (- offset disassem::nil-addr)))
(let ((offs (- disp 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))))))
(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)
......@@ -21,6 +21,8 @@ New in this release:
* Known issues:
* Feature enhancements
* The disassembler (on x86) prints correctly for any value of
* Changes
* 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