X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=af7d67f1fe68366cbeb7e5728d854c0f7d7b0248;hb=731d5dd65a7b94b5d49d1663d9b60c3a406ce38c;hp=ef8169934a9e8ca0a65c23907d3190f8207fae08;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index ef81699..af7d67f 100644
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -261,13 +261,20 @@
        (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))))))
     (list res)))
 
-
 ;;; Given an arbitrary sequence, coerce it to an unsigned vector if
 ;;; possible. Ordinarily we coerce it to the smallest specialized
 ;;; vector we can. However, we also have a special hack for
@@ -524,10 +531,12 @@
 	   (setf (compiled-debug-fun-arguments dfun)
 		 (compute-args fun var-locs))))
 
-    (when (>= 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)))
+    (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-tlf-number dfun) (find-tlf-number fun)))
 
     (if (xep-p fun)
 	(setf (compiled-debug-fun-returns dfun) :standard)