[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-17-g01a3f47
Raymond Toy
rtoy at common-lisp.net
Fri Dec 20 08:09:30 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 01a3f47b4b6d0a6f89bd533c967b32f2357acab6 (commit)
via a013ec10932b01cded996713579f211586250f7c (commit)
from 7916cfb0b1b01e42901d92d9669c3c6099a6cab6 (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 01a3f47b4b6d0a6f89bd533c967b32f2357acab6
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Dec 20 00:09:20 2013 -0800
Regenerated.
diff --git a/src/i18n/locale/cmucl-x87.pot b/src/i18n/locale/cmucl-x87.pot
index 2c52230..d0118ce 100644
--- a/src/i18n/locale/cmucl-x87.pot
+++ b/src/i18n/locale/cmucl-x87.pot
@@ -127,10 +127,6 @@ msgid "inline scalb function"
msgstr ""
#: src/compiler/x86/float.lisp
-msgid "inline log1p function"
-msgstr ""
-
-#: src/compiler/x86/float.lisp
msgid "inline log1p with limited x range function"
msgstr ""
@@ -147,6 +143,10 @@ msgid "inline atan2 function"
msgstr ""
#: src/compiler/x86/float.lisp
+msgid "inline log1p function"
+msgstr ""
+
+#: src/compiler/x86/float.lisp
msgid "inline complex single-float creation"
msgstr ""
diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot
index 283dcaf..0c327c9 100644
--- a/src/i18n/locale/cmucl.pot
+++ b/src/i18n/locale/cmucl.pot
@@ -17157,10 +17157,22 @@ msgstr ""
#: src/compiler/disassem.lisp
msgid ""
-"Disassembles the given area of memory starting at ADDRESS and LENGTH long.\n"
-" Note that if CODE-COMPONENT is NIL and this memory could move during a GC,"
+"Disassembles the given area of memory starting at ADDRESS and\n"
+" LENGTH (octets) long. Note that if CODE-COMPONENT is NIL and this\n"
+" memory could move during a GC, you'd better disable it around the\n"
+" call to this function. ADDRESS can be either an integer or a\n"
+" system-area-pointer.\n"
"\n"
-" you'd better disable it around the call to this function."
+" :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
commit a013ec10932b01cded996713579f211586250f7c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Dec 19 20:15:57 2013 -0800
Make all top-level disassembly functions accept base, case, and radix
options just like for DISASSEM:DISASSEMBLE.
* DISASSEMBLE-SEGMENTS actually implements the base, case and radix
options.
* DISASSEMBLE doesn't implement the options but calls
DISASSEMBLE-SEGMENTS with the appropriate args.
* DISASSEMBLE-FUNCTION, DISASSEMBLE-MEMORY, and
DISASSEMBLE-CODE-COMPONENT accepts the new keyword args.
* Update the docstrings to indicate the new keyword args.
diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 762b77b..cb04a00 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -3232,12 +3232,17 @@
dstate
stream)))
-(defun disassemble-segments (segments stream dstate)
+(defun disassemble-segments (segments stream dstate &key
+ (base 16)
+ (case :downcase)
+ (radix *print-radix*))
"Disassemble the machine code instructions in each memory segment in
SEGMENTS in turn to STREAM."
(declare (type list segments)
(type stream stream)
- (type disassem-state dstate))
+ (type disassem-state dstate)
+ (type (integer 2 36) base)
+ (type (member :upcase :downcase :capitalize) case))
(unless (null segments)
(let ((first (car segments))
(last (car (last segments))))
@@ -3257,15 +3262,21 @@
;; Initialize these to a sane value, just in case.
(setf vm::*note-addis-inst* nil)
(setf vm::*pseudo-atomic-set* nil))
- (dolist (seg segments)
- (disassemble-segment seg stream dstate)))))
+ (let ((*print-base* base)
+ (*print-case* case)
+ (*print-radix* radix))
+ (dolist (seg segments)
+ (disassemble-segment seg stream dstate))))))
;;; ----------------------------------------------------------------
;;; top-level functions
(defun disassemble-function (function &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 instructions for FUNCTION."
(declare (type compiled-function function)
(type stream stream)
@@ -3275,7 +3286,8 @@
(segments (get-function-segments function)))
(when use-labels
(label-segments segments dstate))
- (disassemble-segments segments stream dstate)))
+ (disassemble-segments segments stream dstate
+ :base base :case case :radix radix)))
(defun compile-function-lambda-expr (function)
(declare (type function function))
@@ -3328,33 +3340,49 @@
(declare (type (or function symbol cons) object)
(type (or (member t) stream) stream)
(type (member t nil) use-labels)
- (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)))
+ (type c::backend backend))
+ (let ((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
(disassemble-function (fun-self fun)
:stream stream
:use-labels use-labels
- :backend backend)))
+ :backend backend
+ :base base
+ :case case
+ :radix radix)))
(values))
(defun disassemble-memory (address
length
&key
- (stream *standard-output*)
- code-component
- (use-labels t)
- (backend c:*backend*))
- "Disassembles the given area of memory starting at ADDRESS and LENGTH long.
- Note that if CODE-COMPONENT is NIL and this memory could move during a GC,
- you'd better disable it around the call to this function."
- (declare (type (or address system:system-area-pointer) address)
+ (stream *standard-output*)
+ code-component
+ (use-labels t)
+ (backend c:*backend*)
+ (base 16)
+ (case :downcase)
+ (radix *print-radix*))
+ "Disassembles the given area of memory starting at ADDRESS and
+ LENGTH (octets) long. Note that if CODE-COMPONENT is NIL and this
+ memory could move during a GC, you'd better disable it around the
+ call to this function. ADDRESS can be either an integer or a
+ system-area-pointer.
+
+ :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 address
+ system:system-area-pointer) address)
(type length length)
(type stream stream)
(type (or null kernel:code-component) code-component)
@@ -3379,12 +3407,16 @@
(list (make-memory-segment address length)))))
(when use-labels
(label-segments segments dstate))
- (disassemble-segments segments stream dstate)))
+ (disassemble-segments segments stream dstate
+ :base base :case case :radix radix)))
(defun disassemble-code-component (code-component &key
- (stream *standard-output*)
- (use-labels t)
- (backend c:*native-backend*))
+ (stream *standard-output*)
+ (use-labels t)
+ (backend c:*native-backend*)
+ (base 16)
+ (case :downcase)
+ (radix *print-radix*))
"Disassemble the machine code instructions associated with
CODE-COMPONENT (this may include multiple entry points)."
(declare (type (or null kernel:code-component compiled-function)
@@ -3400,7 +3432,8 @@
(segments (get-code-segments code-component)))
(when use-labels
(label-segments segments dstate))
- (disassemble-segments segments stream dstate)))
+ (disassemble-segments segments stream dstate
+ :base base :case case :radix radix)))
;;; ----------------------------------------------------------------
;;; Code for making useful segments from arbitrary lists of code-blocks
-----------------------------------------------------------------------
Summary of changes:
src/compiler/disassem.lisp | 89 ++++++++++++++++++++++++++++-------------
src/i18n/locale/cmucl-x87.pot | 8 ++--
src/i18n/locale/cmucl.pot | 18 +++++++--
3 files changed, 80 insertions(+), 35 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list