diff --git a/src/code/exports.lisp b/src/code/exports.lisp index b2bdeabd6fedee7d3b5bbed551ba75c5567d7ede..9322c5d12e82a47de9070b377f7cfb0dce1f4f48 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 788a912fc45cc2697085289a4cf707b5ff857333..907ce1c9175b3b18533c2417325bac849ca4a5c9 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 a236592492fad3c03bfed0533cdfe102db39bf01..1316aa2a6a73c4d41ceeb4c4614cf16e2916be20 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 052b4c1a2581e0ca8b2bdef9e07ba928cf3a6c57..b8645dfb2ad9acb96a50b4ab1c0324226c67553d 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 048b9ec4d75c306431b93d56d9de3c0d9b23e711..c0f10342dc1f7e9cdb858ab2e7ea372f38f27791 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 ff7b7cf2d1c610455bc5aed4d3d449fc05474f6b..397fa4ebdb12848d4b0a3a4da401b7388115b23e 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