X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=70b9c183b5c6bcd735a08e592fa62a1bbf2369b6;hb=304c44d731bea3b9ce3c47d864d90eac92ba604e;hp=43a1a1e526abee38dcbaa511d6a5490fd3b8fdb5;hpb=fc999187f3f80dfcf170348df676386b8403e261;p=sbcl.git

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index 43a1a1e..70b9c18 100644
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -141,11 +141,10 @@
 	(when (eq (block-info block) 2block)
 	  (unless (eql (source-path-tlf-number
 			(node-source-path
-			 (continuation-next
-			  (block-start block))))
+			 (block-start-node block)))
 		       res)
 	    (setq res nil)))
-	
+
 	(dolist (loc (ir2-block-locations 2block))
 	  (unless (eql (source-path-tlf-number
 			(node-source-path
@@ -163,7 +162,7 @@
       (write-var-integer (length locations) *byte-buffer*)
       (let ((2block (block-info block)))
 	(write-var-integer (+ (length locations) 1) *byte-buffer*)
-	(dump-1-location (continuation-next (block-start block))
+	(dump-1-location (block-start-node block)
 			 2block :block-start tlf-num
 			 (ir2-block-%label 2block)
 			 (ir2-block-live-out 2block)
@@ -262,6 +261,14 @@
        (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
@@ -525,10 +532,11 @@
 	   (setf (compiled-debug-fun-arguments dfun)
 		 (compute-args fun var-locs))))
 
-    (when (>= level 2)
+    (if (>= level 2)
       (multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
 	(setf (compiled-debug-fun-tlf-number dfun) tlf-num)
-	(setf (compiled-debug-fun-blocks dfun) blocks)))
+	(setf (compiled-debug-fun-blocks dfun) blocks))
+      (setf (compiled-debug-fun-tlf-number dfun) (find-tlf-number fun)))
 
     (if (xep-p fun)
 	(setf (compiled-debug-fun-returns dfun) :standard)