[git] CMU Common Lisp branch master updated. snapshot-2013-08-6-g0331b89
Raymond Toy
rtoy at common-lisp.net
Thu Aug 22 03:16:15 UTC 2013
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 0331b89234436da149eb5b142e206ae5af2d9c7b (commit)
from 864c24bdd0abbf86dd35529c79657c9ed3db62ac (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 0331b89234436da149eb5b142e206ae5af2d9c7b
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Wed Aug 21 20:16:01 2013 -0700
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
diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 13f6b35..a236592 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 2417c04..048b9ec 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))
- , at 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 6c4fd1a..9d91bcc 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.
-----------------------------------------------------------------------
Summary of changes:
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(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list