X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=b1f09cca1a42ba8193f5216a23aa2bbb04b9b9fc;hb=0c0d240960138dbea32ff6e3e65e6f16b1f2f7da;hp=96065f683ffa129dd7d382abeb06d9315268deb4;hpb=a6a12ed609d5467ec43b411283e5b3568fee81df;p=sbcl.git

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 96065f6..b1f09cc 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -1007,7 +1007,7 @@
                 (sb!di:code-location-toplevel-form-offset loc))
           (setf (sfcache-last-form-retrieved cache)
                 (sb!di:code-location-form-number loc))
-          (setf (sfcache-last-location-retrieved cache)))
+          (setf (sfcache-last-location-retrieved cache) loc))
         (values form t))))
 
 ;;;; stuff to use debugging info to augment the disassembly
@@ -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