X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=93dc01643a316f856914ad043632cff5db269e0e;hb=a5b1b81acd785b8864ec8ef48c17ac2b48bc1d06;hp=a2288b8d8336cce69a6d675949d690f4ac58a964;hpb=3b90774a1ea68bf42579594c872de16fb33f1454;p=sbcl.git

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index a2288b8..93dc016 100644
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -250,25 +250,25 @@
 
 ;;; Return DEBUG-SOURCE structure containing information derived from
 ;;; INFO.
-(defun debug-source-for-info (info)
+(defun debug-source-for-info (info &key function)
   (declare (type source-info info))
-  (let* ((file-info (source-info-file-info info))
-         (res (make-debug-source
-               :from :file
-               :created (file-info-write-date file-info)
-               :compiled (source-info-start-time info)
-               :source-root (file-info-source-root file-info)
-               :start-positions (coerce-to-smallest-eltype
-                                 (file-info-positions file-info))))
-         (name (file-info-name file-info)))
-    (etypecase name
-      ((member :lisp)
-       (setf (debug-source-from res) name
-             (debug-source-name res) (file-info-forms file-info)))
-      (pathname
-       (setf (debug-source-name res)
-             (make-file-info-namestring name file-info))))
-    res))
+  (let ((file-info (get-toplevelish-file-info info)))
+    (make-debug-source
+     :compiled (source-info-start-time info)
+
+     :namestring (make-file-info-namestring
+                  (if (pathnamep (file-info-name file-info))
+                      (file-info-name file-info))
+                  file-info)
+     :created (file-info-write-date file-info)
+     :source-root (file-info-source-root file-info)
+     :start-positions (coerce-to-smallest-eltype
+                       (file-info-positions file-info))
+
+     :form (let ((direct-file-info (source-info-file-info info)))
+             (if (eq :lisp (file-info-name direct-file-info))
+                 (elt (file-info-forms direct-file-info) 0)))
+     :function function)))
 
 ;;; Given an arbitrary sequence, coerce it to an unsigned vector if
 ;;; possible. Ordinarily we coerce it to the smallest specialized