(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))))
\f
;;;; stuff to use debugging info to augment the disassembly
))))
(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
(type stream stream)
(type disassem-state dstate))
(unless (null segments)
+ (format stream "~&; Size: ~a bytes"
+ (reduce #'+ segments :key #'seg-length))
(let ((first (car segments))
(last (car (last segments))))
(set-location-printing-range dstate
- (seg-virtual-location first)
- (- (+ (seg-virtual-location last)
- (seg-length last))
- (seg-virtual-location first)))
+ (seg-virtual-location first)
+ (- (+ (seg-virtual-location last)
+ (seg-length last))
+ (seg-virtual-location first)))
(setf (dstate-output-state dstate) :beginning)
(dolist (seg segments)
(disassemble-segment seg stream dstate)))))
(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))
(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
;;; an alist of (SYMBOL-SLOT-OFFSET . ACCESS-FUN-NAME) for slots
;;; in a symbol object that we know about
(defparameter *grokked-symbol-slots*
- (sort `((,sb!vm:symbol-value-slot . symbol-value)
- (,sb!vm:symbol-plist-slot . symbol-plist)
- (,sb!vm:symbol-name-slot . symbol-name)
- (,sb!vm:symbol-package-slot . symbol-package))
+ (sort (copy-list `((,sb!vm:symbol-value-slot . symbol-value)
+ (,sb!vm:symbol-plist-slot . symbol-plist)
+ (,sb!vm:symbol-name-slot . symbol-name)
+ (,sb!vm:symbol-package-slot . symbol-package)))
#'<
:key #'car))