Commit ddfb0372 authored by Raymond Toy's avatar Raymond Toy
Browse files

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.
parent 0331b892
......@@ -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"
......
......@@ -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))
......@@ -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))
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
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