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@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