X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=51b4bcbc66774f6e4b400af70647aed26a6dd65a;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=c0a9e2b313d7ae54c681a171181eb90f3051d0b0;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index c0a9e2b..51b4bcb 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -726,14 +726,18 @@ (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] @@ -780,11 +784,12 @@ (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))) @@ -1588,6 +1593,7 @@ (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) @@ -1595,7 +1601,7 @@ (disassemble-function (fun-self fun) :stream stream :use-labels use-labels))) - (values)) + (values))) (defun disassemble-memory (address length @@ -1781,7 +1787,7 @@ ;;; 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) @@ -1801,7 +1807,7 @@ symbol object that we know about.") (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))