X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=a286675cb8328ff7beef7b5805a54f3437cdf4b0;hb=b43b6e70ce48d959d77f7f56be9d11aa101fdd7d;hp=b0987970467186f84749b5b93dfacb87265418bc;hpb=c2431e2d0d0222a3cf20cfdfa48201bdcc65cd76;p=sbcl.git

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index b098797..a286675 100644
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -20,7 +20,8 @@
 
 (deftype location-kind ()
   '(member :unknown-return :known-return :internal-error :non-local-exit
-           :block-start :call-site :single-value-return :non-local-entry))
+           :block-start :call-site :single-value-return :non-local-entry
+           :step-before-vop))
 
 ;;; The LOCATION-INFO structure holds the information what we need
 ;;; about locations which code generation decided were "interesting".
@@ -89,7 +90,7 @@
 ;;; are spilled.
 (defun dump-1-location (node block kind tlf-num label live var-locs vop)
   (declare (type node node) (type ir2-block block)
-           (type local-tn-bit-vector live)
+           (type (or null local-tn-bit-vector) live)
            (type (or label index) label)
            (type location-kind kind) (type (or index null) tlf-num)
            (type hash-table var-locs) (type (or vop null) vop))
@@ -109,9 +110,19 @@
       (write-var-integer (source-path-tlf-number path) *byte-buffer*))
     (write-var-integer (source-path-form-number path) *byte-buffer*))
 
-  (write-packed-bit-vector (compute-live-vars live node block var-locs vop)
-                           *byte-buffer*)
-
+  (if live
+      (write-packed-bit-vector (compute-live-vars live node block var-locs vop)
+                               *byte-buffer*)
+      (write-packed-bit-vector
+       (make-array (logandc2 (+ (hash-table-count var-locs) 7) 7)
+                   :initial-element 0
+                   :element-type 'bit)
+       *byte-buffer*))
+
+  (write-var-string (or (and (typep node 'combination)
+                             (combination-step-info node))
+                        "")
+                    *byte-buffer*)
   (values))
 
 ;;; Extract context info from a Location-Info structure and use it to
@@ -255,21 +266,8 @@
        (setf (debug-source-from res) name
              (debug-source-name res) (file-info-forms file-info)))
       (pathname
-       (let* ((untruename (file-info-untruename file-info))
-              (dir (pathname-directory untruename)))
-         (setf (debug-source-name res)
-               #+sb-xc-host
-               (let ((src (position "src" dir :test #'string= :from-end t)))
-                 (if src
-                     (format nil "SYS:~{~:@(~A~);~}~:@(~A~).LISP"
-                             (subseq dir src) (pathname-name untruename))
-                     ;; FIXME: just output/stuff-groveled-from-headers.lisp
-                     (namestring untruename)))
-               #-sb-xc-host
-               (namestring
-                (if (and dir (eq (first dir) :absolute))
-                    untruename
-                    name))))))
+       (setf (debug-source-name res)
+             (make-file-info-namestring name file-info))))
     res))
 
 ;;; Given an arbitrary sequence, coerce it to an unsigned vector if
@@ -344,7 +342,7 @@
     (declare (type index flags))
     (when minimal
       (setq flags (logior flags compiled-debug-var-minimal-p))
-      (unless tn
+      (unless (and tn (tn-offset tn))
         (setq flags (logior flags compiled-debug-var-deleted-p))))
     (when (and (or (eq kind :environment)
                    (and (eq kind :debug-environment)
@@ -362,7 +360,7 @@
       (vector-push-extend name buffer)
       (unless (zerop id)
         (vector-push-extend id buffer)))
-    (if tn
+    (if (and tn (tn-offset tn))
         (vector-push-extend (tn-sc-offset tn) buffer)
         (aver minimal))
     (when save-tn
@@ -509,7 +507,7 @@
 (defun compute-1-debug-fun (fun var-locs)
   (declare (type clambda fun) (type hash-table var-locs))
   (let* ((dfun (dfun-from-fun fun))
-         (actual-level (policy (lambda-bind fun) debug))
+         (actual-level (policy (lambda-bind fun) compute-debug-fun))
          (level (if #!+sb-dyncount *collect-dynamic-statistics*
                     #!-sb-dyncount nil
                     (max actual-level 2)