1.0.11.35: fixed bug 417
authorNikodemus Siivola <nikodemus@random-state.net>
Tue, 20 Nov 2007 14:50:40 +0000 (14:50 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Tue, 20 Nov 2007 14:50:40 +0000 (14:50 +0000)
* Don't store non-unique objects like symbols, fixnums,
  or characters in *SOURCE-PATHS*.

* For future refactoring ease, always access *SOURCE-PATHS*
  via GET-SOURCE-PATH and NOTE-SOURCE-PATH.

BUGS
NEWS
src/code/macros.lisp
src/compiler/ir1-translators.lisp
src/compiler/ir1tran.lisp
src/compiler/main.lisp
tests/bug-417.lisp [new file with mode: 0644]
tests/compiler.impure.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index a375a31..55d9b4f 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1838,23 +1838,6 @@ WORKAROUND:
     1: (SB-KERNEL:FDEFINITION-OBJECT 13 NIL)
   as the second frame.
 
-417: Toplevel NIL expressions mess up unreachable code reporting.
-       In sbcl-1.0.10.7, COMPILE-FILE on the file
-               nil
-               (defmethod frob ((package package) stream)
-                 (if (string= (package-name package) "FOO")
-                     (pprint-logical-block (stream nil))
-                     (print-unreadable-object (package stream))))
-       causes complaints like
-               ; in: SOME SB-C::STRANGE SB-C::PLACE
-               ;     (SB-C::UNABLE SB-C::TO SB-C::LOCATE SB-C::SOURCE)
-               ; 
-               ; note: deleting unreachable code
-               ; 
-               ; note: deleting unreachable code
-       Deleting the toplevel NIL, or even replacing it with 3,
-       causes the system not to complain.
-
 418: SUBSEQ on lists doesn't support bignum indexes
 
  LIST-SUBSEQ* now has all the works necessary to support bignum indexes,
diff --git a/NEWS b/NEWS
index 87f44f2..76e2308 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,7 @@ changes in sbcl-1.0.12 relative to sbcl-1.0.11:
   * optimization: CONCATENATE on strings is an order of magnitue faster
     in code compiled with (> SPEED SPACE).
   * optimization: SUBSEQ is ~50% faster on lists.
+  * bug fix: bug 417 fixed -- source location reporting is now more robust.
   * bug fix: SUBSEQ on a list will now correctly signal an error if if
     END is smaller then START.
   * bug fix: SB-PROFILE will no longer report extra consing for nested
index 3da5529..ebddde6 100644 (file)
@@ -216,7 +216,7 @@ invoked. In that case it will store into PLACE and start over."
                      do (when existing
                           (let ((sb!c::*current-path*
                                  (when (boundp 'sb!c::*source-paths*)
-                                   (or (gethash case sb!c::*source-paths*)
+                                   (or (sb!c::get-source-path case)
                                        sb!c::*current-path*))))
                             (warn 'duplicate-case-key-warning
                                   :key k
index e4c4d62..affa00f 100644 (file)
@@ -74,7 +74,7 @@ otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
   (if (policy *lexenv* (= store-coverage-data 0))
       nil
       (labels ((sub (form)
-                 (or (gethash form *source-paths*)
+                 (or (get-source-path form)
                      (and (consp form)
                           (some #'sub form)))))
         (or (sub form)))))
index 15ac812..f19f445 100644 (file)
 
 (declaim (special *compiler-error-bailout*))
 
+;;; *CURRENT-FORM-NUMBER* is used in FIND-SOURCE-PATHS to compute the
+;;; form number to associate with a source path. This should be bound
+;;; to an initial value of 0 before the processing of each truly
+;;; top level form.
+(declaim (type index *current-form-number*))
+(defvar *current-form-number*)
+
 ;;; *SOURCE-PATHS* is a hashtable from source code forms to the path
 ;;; taken through the source to reach the form. This provides a way to
 ;;; keep track of the location of original source forms, even when
 ;;; macroexpansions and other arbitary permutations of the code
 ;;; happen. This table is initialized by calling FIND-SOURCE-PATHS on
 ;;; the original source.
+;;;
+;;; It is fairly useless to store symbols, characters, or fixnums in
+;;; this table, as 42 is EQ to 42 no matter where in the source it
+;;; appears. GET-SOURCE-PATH and NOTE-SOURCE-PATH functions should be
+;;; always used to access this table.
 (declaim (hash-table *source-paths*))
 (defvar *source-paths*)
 
+(declaim (inline source-form-hash-path-p))
+(defun source-form-has-path-p (form)
+  (not (typep form '(or symbol fixnum character))))
+
+(defun get-source-path (form)
+  (when (source-form-has-path-p form)
+    (gethash form *source-paths*)))
+
+(defun note-source-path (form &rest arguments)
+  (when (source-form-has-path-p form)
+    (setf (gethash form *source-paths*)
+          (apply #'list* 'original-source-start *current-form-number* arguments))))
+
 ;;; *CURRENT-COMPONENT* is the COMPONENT structure which we link
 ;;; blocks into as we generate them. This just serves to glue the
 ;;; emitted blocks together until local call analysis and flow graph
             (functional-kind res) :toplevel)
       res)))
 
-;;; *CURRENT-FORM-NUMBER* is used in FIND-SOURCE-PATHS to compute the
-;;; form number to associate with a source path. This should be bound
-;;; to an initial value of 0 before the processing of each truly
-;;; top level form.
-(declaim (type index *current-form-number*))
-(defvar *current-form-number*)
-
 ;;; This function is called on freshly read forms to record the
 ;;; initial location of each form (and subform.) Form is the form to
 ;;; find the paths in, and TLF-NUM is the top level form number of the
     (sub-find-source-paths form (list tlf-num)))
   (values))
 (defun sub-find-source-paths (form path)
-  (unless (gethash form *source-paths*)
-    (setf (gethash form *source-paths*)
-          (list* 'original-source-start *current-form-number* path))
+  (unless (get-source-path form)
+    (note-source-path form path)
     (incf *current-form-number*)
     (let ((pos 0)
           (subform form)
                             ;; Otherwise store the containing form. It's
                             ;; not perfect, but better than nothing.
                             (unless (zerop pos)
-                              (setf (gethash subform *source-paths*)
-                                    (list* 'original-source-start
-                                           *current-form-number*
-                                           pos
-                                           path))))
+                              (note-source-path subform pos path)))
                         (incf pos))
                       (setq subform (cdr subform))
                       (when (eq subform trail) (return)))))
   ;; namespace.
   (defun ir1-convert (start next result form)
     (ir1-error-bailout (start next result form)
-      (let* ((*current-path* (or (gethash form *source-paths*)
+      (let* ((*current-path* (or (get-source-path form)
                                  (cons form *current-path*)))
              (start (instrument-coverage start nil form)))
         (cond ((atom form)
 ;;; EQness of the conses.
 (defun maybe-instrument-progn-like (start forms form)
   (or (when (and *allow-instrumenting*
-                 (not (gethash form *source-paths*)))
-        (let ((*current-path* (gethash forms *source-paths*)))
+                 (not (get-source-path form)))
+        (let ((*current-path* (get-source-path forms)))
           (when *current-path*
             (instrument-coverage start nil form))))
       start))
index 7b671c4..57ec2ee 100644 (file)
   (declare (list path))
 
   (catch 'process-toplevel-form-error-abort
-    (let* ((path (or (gethash form *source-paths*) (cons form path)))
+    (let* ((path (or (get-source-path form) (cons form path)))
            (*compiler-error-bailout*
             (lambda (&optional condition)
               (convert-and-maybe-compile
diff --git a/tests/bug-417.lisp b/tests/bug-417.lisp
new file mode 100644 (file)
index 0000000..87e3a37
--- /dev/null
@@ -0,0 +1,6 @@
+;;; bug 417: toplevel nil confusing source-path logic
+nil
+(defmethod frob ((package package) stream)
+  (if (string= (package-name package) "FOO")
+      (pprint-logical-block (stream nil))
+      (print-unreadable-object (package stream))))
index 9431e70..fa098af 100644 (file)
            (quux)))))
 (assert (equal '(1 2 3) (wpo-multiple-call-local)))
 
+;;; bug 417: toplevel NIL confusing source path logic
+(handler-case
+    (delete-file (compile-file "bug-417.lisp"))
+  (sb-ext:code-deletion-note (e)
+    (error e)))
+
 ;;; success
index 156fa07..2d09e3a 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.11.34"
+"1.0.11.35"