X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=1c3d4b2a33ce49f33863228dfcd74f11655b267c;hb=70c6facc145eaf5ca368528b04df63f730746b1f;hp=3339a73ad8bd1f0db664d36e2bf85272fffbede7;hpb=2063c1c13530ea18bf93cfaedb03bab755ea8970;p=sbcl.git

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 3339a73..1c3d4b2 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -492,7 +492,8 @@
            (type (or null stream) stream))
 
   (let ((ispace (get-inst-space))
-        (prefix-p nil)) ; just processed a prefix inst
+        (prefix-p nil) ; just processed a prefix inst
+        (prefix-len 0)) ; length of any prefix instruction(s)
 
     (rewind-current-segment dstate segment)
 
@@ -535,19 +536,22 @@
                             (when prefilter
                               (funcall prefilter chunk dstate))
 
+                            (setf prefix-p (null (inst-printer inst)))
+
                             ;; print any instruction bytes recognized by the prefilter which calls read-suffix
                             ;; and updates next-offs
                             (when stream
                               (let ((suffix-len (- (dstate-next-offs dstate) orig-next)))
                                 (when (plusp suffix-len)
                                   (print-inst suffix-len stream dstate :offset (inst-length inst) :trailing-space nil))
-                              (dotimes (i (- *disassem-inst-column-width* (* 2 (+ (inst-length inst) suffix-len))))
-                                (write-char #\space stream)))
-                              (write-char #\space stream))
+                                (unless prefix-p
+                                  (dotimes (i (- *disassem-inst-column-width* (* 2 (+ (inst-length inst) suffix-len prefix-len))))
+                                    (write-char #\space stream))
+                                  (write-char #\space stream))
 
-                            (funcall function chunk inst)
+                                (setf prefix-len (+ (inst-length inst) suffix-len))))
 
-                            (setf prefix-p (null (inst-printer inst)))
+                            (funcall function chunk inst)
 
                             (when control
                               (funcall control chunk inst stream dstate))
@@ -557,6 +561,7 @@
 
       (unless (null stream)
         (unless prefix-p
+          (setf prefix-len 0)
           (print-notes-and-newline stream dstate))
         (setf (dstate-output-state dstate) nil)))))
 
@@ -791,6 +796,7 @@
 ;;; Make a disassembler-state object.
 (defun make-dstate (&optional (fun-hooks *default-dstate-hooks*))
   (let ((sap
+         ;; FIXME: What is this for? This cannot be safe!
          (sb!sys:vector-sap (coerce #() '(vector (unsigned-byte 8)))))
         (alignment *disassem-inst-alignment-bytes*)
         (arg-column
@@ -822,8 +828,8 @@
 
 ;;; A SAP-MAKER is a no-argument function that returns a SAP.
 
+;; FIXME: Are the objects we are taking saps for always pinned?
 #!-sb-fluid (declaim (inline sap-maker))
-
 (defun sap-maker (function input offset)
   (declare (optimize (speed 3))
            (type (function (t) sb!sys:system-area-pointer) function)
@@ -941,12 +947,15 @@
   (last-location-retrieved nil :type (or null sb!di:code-location))
   (last-form-retrieved -1 :type fixnum))
 
+;;; OAOO note: this shares a lot of implementation with
+;;; SB-DEBUG::GET-FILE-TOPLEVEL-FORM.  Perhaps these should be merged
+;;; somehow.
 (defun get-toplevel-form (debug-source tlf-index)
-  (let ((name (sb!di:debug-source-name debug-source)))
-    (ecase (sb!di:debug-source-from debug-source)
-      (:file
-       (cond ((not (probe-file name))
-              (warn "The source file ~S no longer seems to exist." name)
+  (cond
+    ((sb!di:debug-source-namestring debug-source)
+     (let ((namestring (sb!di:debug-source-namestring debug-source)))
+       (cond ((not (probe-file namestring))
+              (warn "The source file ~S no longer seems to exist." namestring)
               nil)
              (t
               (let ((start-positions
@@ -961,15 +970,15 @@
                                    debug-source)))
                               (char-offset
                                (aref start-positions local-tlf-index)))
-                         (with-open-file (f name)
+                         (with-open-file (f namestring)
                            (cond ((= (sb!di:debug-source-created debug-source)
-                                     (file-write-date name))
+                                     (file-write-date namestring))
                                   (file-position f char-offset))
                                  (t
                                   (warn "Source file ~S has been modified; ~@
                                          using form offset instead of ~
                                          file index."
-                                        name)
+                                        namestring)
                                   (let ((*read-suppress* t))
                                     (dotimes (i local-tlf-index) (read f)))))
                            (let ((*readtable* (copy-readtable)))
@@ -979,10 +988,11 @@
                                 (declare (ignore rest sub-char))
                                 (let ((token (read stream t nil t)))
                                   (format nil "#.~S" token))))
-                             (read f))
-                           ))))))))
-      (:lisp
-       (aref name tlf-index)))))
+                             (read f)))))))))))
+    ((sb!di:debug-source-form debug-source)
+     (sb!di:debug-source-form debug-source))
+    (t (bug "Don't know how to use a DEBUG-SOURCE without ~
+             a namestring or a form."))))
 
 (defun cache-valid (loc cache)
   (and cache
@@ -1011,7 +1021,7 @@
             (sfcache-form-number-mapping-table cache) mapping-table))
     (cond ((null toplevel-form)
            nil)
-          ((> form-number (length mapping-table))
+          ((>= form-number (length mapping-table))
            (warn "bogus form-number in form!  The source file has probably ~@
                   been changed too much to cope with.")
            (when cache