(when (null plen)
(setf plen location-column-width)
- (set-location-printing-range dstate
- (seg-virtual-location (dstate-segment dstate))
- (seg-length (dstate-segment dstate))))
+ (let ((seg (dstate-segment dstate)))
+ (set-location-printing-range dstate
+ (seg-virtual-location seg)
+ (seg-length seg))))
(when (eq (dstate-output-state dstate) :beginning)
(setf plen location-column-width))
(fresh-line stream)
+ (setf location-column-width (+ 2 location-column-width))
+ (princ "; " stream)
+
;; print the location
;; [this is equivalent to (format stream "~V,'0x:" plen printed-value), but
;; usually avoids any consing]
(with-print-restrictions
(dolist (note (dstate-notes dstate))
(format stream "~Vt; " *disassem-note-column*)
+ (pprint-logical-block (stream nil :per-line-prefix "; ")
(etypecase note
(string
(write-string note stream))
(function
- (funcall note stream)))
+ (funcall note stream))))
(terpri stream))
(fresh-line stream)
(setf (dstate-notes dstate) nil)))
(declare (type (or function symbol cons) object)
(type (or (member t) stream) stream)
(type (member t nil) use-labels))
+ (pprint-logical-block (*standard-output* nil :per-line-prefix "; ")
(let ((fun (compiled-function-or-lose object)))
(if (typep fun 'sb!kernel:byte-function)
(sb!c:disassem-byte-fun fun)
(disassemble-function (fun-self fun)
:stream stream
:use-labels use-labels)))
- (values))
+ (values)))
(defun disassemble-memory (address
length
\f
;;; routines to find things in the Lisp environment
-(defconstant groked-symbol-slots
+(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)
(declare (type address address))
(if (not (aligned-p address sb!vm:word-bytes))
(values nil nil)
- (do ((slots-tail groked-symbol-slots (cdr slots-tail)))
+ (do ((slots-tail *grokked-symbol-slots* (cdr slots-tail)))
((null slots-tail)
(values nil nil))
(let* ((field (car slots-tail))