The branch "master" has been updated in SBCL:
via 6d9e2243954872457115bbb9ac1ecb1d161acced (commit)
from 28346e0e47ab48ff7f8ba3de73840a4992bab28d (commit)
- Log -----------------------------------------------------------------
commit 6d9e2243954872457115bbb9ac1ecb1d161acced
Author: Stas Boukarev <stassats@...>
Date: Sat Aug 25 03:34:47 2012 +0400
disassemble: New customization variable sb-ext:*disassemble-annotate*.
sb-ext:*disassemble-annotate*: Controls whether to annotate
DISASSEMBLE output with source forms, defaults to T.
Also remove an unused function.
---
NEWS | 2 ++
package-data-list.lisp-expr | 1 +
src/compiler/target-disassem.lisp | 19 ++++++-------------
3 files changed, 9 insertions(+), 13 deletions(-)
diff --git a/NEWS b/NEWS
index 3caaead..647df01 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
;;;; -*- coding: utf-8; fill-column: 78 -*-
changes relative to sbcl-1.0.58:
+ * enhancement: New variable, sb-ext:*disassemble-annotate* for controlling
+ source annotation of DISASSEMBLE output. Defaults to T.
* optimization: CL:SORT and CL:STABLE-SORT of lists are faster and use fewer
comparisons, particularly on almost-sorted inputs.
* documentation: a section on random number generation has been added to the
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 1ff195b..42e5b84 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -812,6 +812,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
"DEFINED-TYPE-NAME-P" "VALID-TYPE-SPECIFIER-P"
"DELETE-DIRECTORY"
"SET-SBCL-SOURCE-LOCATION"
+ "*DISASSEMBLE-ANNOTATE*"
;; stepping interface
"STEP-CONDITION" "STEP-FORM-CONDITION" "STEP-FINISHED-CONDITION"
diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 5f053c5..b1f09cc 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -1228,11 +1228,15 @@
))))
(sb!di:no-debug-blocks () nil)))))
+(defvar *disassemble-annotate* t
+ "Annotate DISASSEMBLE output with source code.")
+
(defun add-debugging-hooks (segment debug-fun &optional sfcache)
(when debug-fun
(setf (seg-storage-info segment)
(storage-info-for-debug-fun debug-fun))
- (add-source-tracking-hooks segment debug-fun sfcache)
+ (when *disassemble-annotate*
+ (add-source-tracking-hooks segment debug-fun sfcache))
(let ((kind (sb!di:debug-fun-kind debug-fun)))
(flet ((add-new-hook (n)
(push (make-offs-hook
@@ -1450,17 +1454,6 @@
(label-segments segments dstate))
(disassemble-segments segments stream dstate)))
-;;; FIXME: We probably don't need this any more now that there are
-;;; no interpreted functions, only compiled ones.
-(defun compile-function-lambda-expr (function)
- (declare (type function function))
- (multiple-value-bind (lambda closurep name)
- (function-lambda-expression function)
- (declare (ignore name))
- (when closurep
- (error "can't compile a lexical closure"))
- (compile nil lambda)))
-
(defun valid-extended-function-designators-for-disassemble-p (thing)
(cond ((legal-fun-name-p thing)
(compiled-funs-or-lose (fdefinition thing) thing))
@@ -1485,7 +1478,7 @@
(error 'simple-type-error
:datum thing
:expected-type '(satisfies valid-extended-function-designators-for-disassemble-p)
- :format-control "can't make a compiled function from ~S"
+ :format-control "Can't make a compiled function from ~S"
:format-arguments (list name)))))
(defun disassemble (object &key
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|