X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsource-location.lisp;h=be5d1fdedf5c4a487eb7c1618cf4b90785d04958;hb=007bcd5aac2f3a1e714563bd39f7a2db2d0bf7c2;hp=b96898b77bf903272c6b1a5cd1a4cea179150790;hpb=31f072311935e32751508ecf824905c6b58a1d95;p=sbcl.git

diff --git a/src/code/source-location.lisp b/src/code/source-location.lisp
index b96898b..be5d1fd 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
@@ -30,6 +30,7 @@
   (plist *source-plist*))
 
 (defun make-file-info-namestring (name file-info)
+  #+sb-xc-host (declare (ignore name))
   (let* ((untruename (file-info-untruename file-info))
          (dir (and untruename (pathname-directory untruename))))
     #+sb-xc-host
@@ -49,10 +50,14 @@
 
 #!+sb-source-locations
 (define-compiler-macro source-location (&environment env)
-  #-sb-xc-host
-  (unless (policy env (and (> space 1)
-                           (> space debug)))
-    (make-definition-source-location)))
+  (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