[git] CMU Common Lisp branch master updated. snapshot-2013-08-7-gddfb037
Raymond Toy
rtoy at common-lisp.net
Sat Aug 24 02:38:49 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 ddfb0372fb591209c4aba8ea46f94e469e0686ca (commit)
from 0331b89234436da149eb5b142e206ae5af2d9c7b (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 ddfb0372fb591209c4aba8ea46f94e469e0686ca
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Aug 23 19:38:38 2013 -0700
Make CL:DISASSEMBLE conforming. Also update some of the
implementation details of DISASSEM:DISASSEMBLE.
code/exports.lisp::
* Update packages so CL:DISASSEMBLE is not DISASSEM:DISASSEMBLE.
code/misc.lisp::
* Define CL:DISASSEMBLE.
compiler/fndb.lisp::
* Update defknow for disassemble.
compiler/disassem.lisp::
* Print of source codes uses standard I/O syntax instead of
inheriting from the environment.
* Add new keyword arguments to DISASSEM:DISASSEMBLE for the base,
case, and radix. These default to 16, :downcase, and
*print-radix*, respectively. This means disassembly now prints out
all numbers in base 16 and is in lowercase.
* When printing a note for an assembler routine, we don't need to
print the (hex) address if *print-base* is 16.
compiler/x86/insts.lisp::
* Fix some issues when in print-mem-access.
* Sometimes the absolute value of the value was printed instead of
the value (displaying the wrong value).
* Print out the value as an unsigned in some cases instead of
signed value.
* Fix print-label to print addresses as unsigned integers. This
fixes the issue where things like call #x-4xxxxxxx were printed.
i18n/locale/cmucl.pot::
* Update because of new or changed docstrings.
diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index b2bdeab..9322c5d 100644
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -1198,9 +1198,8 @@
))
(defpackage "CONDITIONS")
-(intern "DISASSEMBLE" "LISP")
(defpackage "DISASSEM"
- (:import-from "LISP" "DISASSEMBLE")
+ (:shadow "DISASSEMBLE")
(:export "*NOTE-COLUMN*" "*OPCODE-COLUMN-WIDTH*" "ADD-COMMENT-HOOK"
"ADD-HOOK" "ADD-NOTE-HOOK" "ARG-VALUE" "CREATE-DSTATE"
"DISASSEM-STATE" "DISASSEMBLE" "DISASSEMBLE-CODE-COMPONENT"
diff --git a/src/code/misc.lisp b/src/code/misc.lisp
index 788a912..907ce1c 100644
--- a/src/code/misc.lisp
+++ b/src/code/misc.lisp
@@ -259,3 +259,10 @@
loaded, ed can be used to edit a file"
(declare (ignorable x))
(values))
+
+(defun disassemble (object)
+ "Disassemble the machine code associated with OBJECT, which can be a
+ function, a lambda expression, or a symbol with a function definition. If
+ it is not already compiled, the compiler is called to produce something to
+ disassemble."
+ (disassem:disassemble object))
diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index a236592..1316aa2 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -2964,7 +2964,7 @@
(when stream
(unless at-block-begin
(terpri stream))
- (let ((*print-base* 10))
+ (with-standard-io-syntax
(pprint-logical-block (stream nil :per-line-prefix ";;; ")
(format stream "[~D] "
(di:code-location-form-number loc))
@@ -3304,17 +3304,36 @@
:format-arguments (list name)))))
(defun disassemble (object &key (stream *standard-output*)
- (use-labels t)
- (backend c:*native-backend*))
+ (use-labels t)
+ (backend c:*native-backend*)
+ (base 16)
+ (case :downcase)
+ (radix *print-radix*))
"Disassemble the machine code associated with OBJECT, which can be a
function, a lambda expression, or a symbol with a function definition. If
it is not already compiled, the compiler is called to produce something to
- disassemble."
+ disassemble.
+
+ :Stream stream
+ The dissassembly is written to this stream.
+ :Use-labels
+ Labels are generated instead of using instruction addresses.
+ :Base
+ :Case
+ :Radix
+ The disassembler uses the specified base, case, and radix when
+ printing the disassembled code. The default values are 16,
+ :downcase, and *print-radix*, respectively."
(declare (type (or function symbol cons) object)
(type (or (member t) stream) stream)
(type (member t nil) use-labels)
- (type c::backend backend))
- (let ((fun (compiled-function-or-lose object)))
+ (type c::backend backend)
+ (type (integer 2 36) base)
+ (type (member :upcase :downcase :capitalize) case))
+ (let ((*print-base* base)
+ (*print-case* case)
+ (*print-radix* radix)
+ (fun (compiled-function-or-lose object)))
(if (typep fun 'kernel:byte-function)
(c:disassem-byte-fun fun)
;; we can't detect closures, so be careful
@@ -3748,8 +3767,12 @@ symbol object that we know about.")
(find-assembler-routine address))))
(unless (null name)
(note #'(lambda (stream)
- (if NOTE-ADDRESS-P
- (format stream "#x~8,'0x: ~a" address name)
+ (if note-address-p
+ ;; No need to print out the address in hex if the
+ ;; print-base is already 16.
+ (if (= *print-base* 16)
+ (format stream " ~A" name)
+ (format stream "#x~8,'0x: ~a" address name))
(princ name stream)))
dstate))
name))
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 052b4c1..b8645df 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1156,9 +1156,7 @@
(:xref t))
(values (or pathname null) boolean boolean))
-(defknown disassemble ((or callable cons)
- &key (:stream stream) (:backend backend)
- (:use-labels t))
+(defknown disassemble ((or callable cons))
(values))
(defknown documentation (t symbol)
diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 048b9ec..c0f1034 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -433,11 +433,7 @@
(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)))
+ (let ((unsigned-offset (ldb (byte vm:word-bits 0) disp)))
(or (nth-value 1
(disassem::note-code-constant-absolute unsigned-offset
dstate))
@@ -448,8 +444,12 @@
(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)))
+ (disassem::maybe-note-static-function offs dstate)))))
+ (cond ((or base index)
+ (write-char (if (minusp disp) #\- #\+) stream)
+ (princ (abs disp) stream))
+ (t
+ (princ unsigned-offset stream))))))
(write-char #\] stream))
(defun print-imm-data (value stream dstate)
@@ -457,9 +457,7 @@
(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))
- (+ value #x100000000)
- value)))
+ (let ((unsigned-offset (ldb (byte vm:word-bits 0) value)))
(disassem::maybe-note-assembler-routine unsigned-offset stream dstate))
(nth-value 1
(disassem::note-code-constant-absolute offset
@@ -493,7 +491,10 @@
(defun print-label (value stream dstate)
(declare (ignore dstate))
- (disassem:princ16 value stream))
+ (princ (if (and (numberp value) (minusp value))
+ (ldb (byte vm:word-bits 0) value)
+ value)
+ stream))
;;; Returns either an integer, meaning a register, or a list of
;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component
diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot
index ff7b7cf..397fa4e 100644
--- a/src/i18n/locale/cmucl.pot
+++ b/src/i18n/locale/cmucl.pot
@@ -5607,6 +5607,16 @@ msgid ""
" loaded, ed can be used to edit a file"
msgstr ""
+#: src/code/misc.lisp
+msgid ""
+"Disassemble the machine code associated with OBJECT, which can be a\n"
+" function, a lambda expression, or a symbol with a function definition. "
+"If\n"
+" it is not already compiled, the compiler is called to produce something "
+"to\n"
+" disassemble."
+msgstr ""
+
#: src/code/extensions.lisp
msgid ""
"This function can be used as the default value for keyword arguments that\n"
@@ -17133,7 +17143,18 @@ msgid ""
"If\n"
" it is not already compiled, the compiler is called to produce something "
"to\n"
-" disassemble."
+" disassemble.\n"
+"\n"
+" :Stream stream\n"
+" The dissassembly is written to this stream.\n"
+" :Use-labels\n"
+" Labels are generated instead of using instruction addresses.\n"
+" :Base\n"
+" :Case\n"
+" :Radix\n"
+" The disassembler uses the specified base, case, and radix when\n"
+" printing the disassembled code. The default values are 16,\n"
+" :downcase, and *print-radix*, respectively."
msgstr ""
#: src/compiler/disassem.lisp
-----------------------------------------------------------------------
Summary of changes:
src/code/exports.lisp | 3 +--
src/code/misc.lisp | 7 +++++++
src/compiler/disassem.lisp | 39 +++++++++++++++++++++++++++++++--------
src/compiler/fndb.lisp | 4 +---
src/compiler/x86/insts.lisp | 23 ++++++++++++-----------
src/i18n/locale/cmucl.pot | 23 ++++++++++++++++++++++-
6 files changed, 74 insertions(+), 25 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list