[Sbcl-commits] CVS: sbcl/src/code condition.lisp, 1.90, 1.91 early-source-location.lisp, 1.2, 1.3 source-location.lisp, 1.3, 1.4

[Richard M K. <kr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7229/src/code

Modified Files:
	condition.lisp early-source-location.lisp source-location.lisp 
Log Message:
1.0.18.20: Fewer STYLE-WARNINGs.

* Change definition of UNINTERESTING-ORDINARY-FUNCTION-REDEFINITION-P
  so that replacing an interpreted function is always uninteresting
  when the new definition comes from the same file.

* Monkey with source-locations so that they get created during LOAD of
  a source file when *EVALUATOR-MODE* is :INTERPRET.


Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -d -r1.90 -r1.91
--- condition.lisp	11 Jul 2008 18:55:08 -0000	1.90
+++ condition.lisp	16 Jul 2008 19:21:03 -0000	1.91
@@ -1398,11 +1398,10 @@
        ;; clearly uninteresting, and we'll say arbitrarily that
        ;; replacing an interpreted function with an interpreted
        ;; function is uninteresting, too, but leave out the
-       ;; compiled-to-interpreted and interpreted-to-compiled cases.
-       (when (or (and (typep old-fdefn
-                             '(or #!+sb-eval sb!eval:interpreted-function))
-                      (typep new-fdefn
-                             '(or #!+sb-eval sb!eval:interpreted-function)))
+       ;; compiled-to-interpreted case.
+       (when (or (typep
+                  old-fdefn
+                  '(or #!+sb-eval sb!eval:interpreted-function))
                  (and (typep old-fdefn
                              '(and compiled-function
                                (not funcallable-instance)))

Index: early-source-location.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-source-location.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- early-source-location.lisp	6 May 2008 10:45:43 -0000	1.2
+++ early-source-location.lisp	16 Jul 2008 19:21:04 -0000	1.3
@@ -23,8 +23,7 @@
 
 (defvar *source-location-thunks* nil)
 
-;; Should get called only in unusual circumstances. Normally handled
-;; by a compiler macro.
+;; Will be redefined in src/code/source-location.lisp.
 (defun source-location ()
   nil)
 
@@ -35,7 +34,7 @@
              (symbol-value '*source-info*))
     `(cons ,(make-file-info-namestring
               *compile-file-pathname*
-              (source-info-file-info (symbol-value '*source-info*)))
+              (sb!c:get-toplevelish-file-info (symbol-value '*source-info*)))
            ,(when (boundp '*current-path*)
                   (source-path-tlf-number (symbol-value '*current-path*))))))
 

Index: source-location.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/source-location.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- source-location.lisp	8 Jul 2008 21:31:53 -0000	1.3
+++ source-location.lisp	16 Jul 2008 19:21:05 -0000	1.4
@@ -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
@@ -53,6 +53,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*)