X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsource-location.lisp;h=7eb411bfe6f8cad09a74bcc8e6487d20d3ad4864;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=9cb1a9a2564586f8c369d1fa23e725857428835d;hpb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;p=sbcl.git

diff --git a/src/code/source-location.lisp b/src/code/source-location.lisp
index 9cb1a9a..7eb411b 100644
--- a/src/code/source-location.lisp
+++ b/src/code/source-location.lisp
@@ -19,7 +19,7 @@
    (when (and (boundp '*source-info*)
               *source-info*)
      (make-file-info-namestring *compile-file-pathname*
-                                (source-info-file-info *source-info*)))
+                                (sb!c:get-toplevelish-file-info *source-info*)))
    :type (or string null))
   ;; Toplevel form index
   (toplevel-form-number
@@ -36,11 +36,13 @@
     #+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)))
+      (cond
+        (src (format nil "SYS:~{~:@(~A~);~}~:@(~A~).LISP"
+                     (subseq dir src) (pathname-name untruename)))
+        (t (aver (string-equal (car (last dir)) "output"))
+           (aver (string-equal (pathname-name untruename) "stuff-groveled-from-headers"))
+           (aver (string-equal (pathname-type untruename) "lisp"))
+           "SYS:OUTPUT;STUFF-GROVELED-FROM-HEADERS.LISP")))
     #-sb-xc-host
     (if (and dir (eq (first dir) :absolute))
         (namestring untruename)
@@ -53,6 +55,12 @@
   (declare (ignore env))
   #-sb-xc-host (make-definition-source-location))
 
+;; We need a regular definition of SOURCE-LOCATION for calls processed
+;; during LOAD on a source file while *EVALUATOR-MODE* is :INTERPRET.
+#!+sb-source-locations
+(setf (symbol-function 'source-location)
+      (lambda () (make-definition-source-location)))
+
 (/show0 "/Processing source location thunks")
 #!+sb-source-locations
 (dolist (fun *source-location-thunks*)