X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=51b4bcbc66774f6e4b400af70647aed26a6dd65a;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=8321b37311a2f590cb11f86119449f38657e1935;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 8321b37..51b4bcb 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -11,9 +11,6 @@
 
 (in-package "SB!DISASSEM")
 
-(file-comment
-  "$Header$")
-
 ;;;; FIXME: A lot of stupid package prefixes would go away if DISASSEM
 ;;;; would use the SB!DI package. And some more would go away if it would
 ;;;; use SB!SYS (in order to get to the SAP-FOO operators).
@@ -729,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]
@@ -783,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)))
@@ -1591,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)
@@ -1598,7 +1601,7 @@
 	(disassemble-function (fun-self fun)
 			      :stream stream
 			      :use-labels use-labels)))
-  (values))
+  (values)))
 
 (defun disassemble-memory (address
 			   length
@@ -1784,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)
@@ -1804,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))