From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 29 Jan 2008 12:51:26 +0000 (+0000)
Subject: 1.0.14.2: XREF needs to account for the last node of a block as well
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=65dc8d30b1f8389faa549af10e72b9e677bec5d3;p=sbcl.git

1.0.14.2: XREF needs to account for the last node of a block as well

 * ...as it can be eg. a CSET node. Reported by "mogunus" on #lisp.

 Lest readers of sbcl-commits start thinking that #lisp is the best
 place to report bugs: it is not. This got immediate attention as I
 was working in closely related areas anyways.

 sbcl-devel and sbcl-help remain the correct place to report bugs.
---

diff --git a/NEWS b/NEWS
index 5b68f00..e3a7516 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes in sbcl-1.0.15 relative to sbcl-1.0.14:
     well as other cases where the interesting frames used to be
     obscured by interrupt handling frames.
   * bug fix: SORT was not interrupt safe.
+  * bug fix: XREF accounts for the last node of each basic-block as
+    well.
 
 changes in sbcl-1.0.14 relative to sbcl-1.0.13:
   * new feature: SB-EXT:*EXIT-HOOKS* are called when the process exits
diff --git a/contrib/sb-introspect/xref-test-data.lisp b/contrib/sb-introspect/xref-test-data.lisp
index f529839..a23c328 100644
--- a/contrib/sb-introspect/xref-test-data.lisp
+++ b/contrib/sb-introspect/xref-test-data.lisp
@@ -102,6 +102,13 @@
       ;; Doesn't count as calling xref/3, or referring to +z+ / *a*
       (inline/1))))
 
+;; last node of block should also be taken into account
+(defun xref/13 (x)
+  (setf *a* x))
+
+(defun xref/14 ()
+  *a*)
+
 ;; calling a function in a macro body
 (defmacro macro/1 ()
   (when nil
diff --git a/contrib/sb-introspect/xref-test.lisp b/contrib/sb-introspect/xref-test.lisp
index 8765f84..e197090 100644
--- a/contrib/sb-introspect/xref-test.lisp
+++ b/contrib/sb-introspect/xref-test.lisp
@@ -29,9 +29,9 @@
                  ((sb-introspect::who-macroexpands 'macro/1)
                   (macro-use/1 macro-use/2 macro-use/3 macro-use/4 inline/2))
                  ((sb-introspect::who-binds '*a*) (xref/2))
-                 ((sb-introspect::who-sets '*a*) (xref/2))
+                 ((sb-introspect::who-sets '*a*) (xref/2 xref/13))
                  ((sb-introspect::who-references '*a*)
-                  (xref/1 xref/2 xref/4 inline/1))
+                  (xref/1 xref/2 xref/4 inline/1 xref/14))
                  ((sb-introspect::who-references '+z+)
                   (inline/1)))))
     (loop for x in tests
diff --git a/src/compiler/xref.lisp b/src/compiler/xref.lisp
index 4ea73e4..48d2a54 100644
--- a/src/compiler/xref.lisp
+++ b/src/compiler/xref.lisp
@@ -19,16 +19,15 @@
     (return-from record-component-xrefs))
   (do ((block (block-next (component-head component)) (block-next block)))
       ((null (block-next block)))
-    (let* ((this-cont (block-start block))
-           (last (block-last block)))
+    (let ((start (block-start block)))
       (flet ((handle-node (functional)
                ;; Record xref information for all nodes in the block.
                ;; Note that this code can get executed several times
                ;; for the same block, if the functional is referenced
                ;; from multiple XEPs.
-               (loop for node = (ctran-next this-cont)
-                     then (ctran-next (node-next node))
-                     until (eq node last)
+               (loop for ctran = start then (node-next node)
+                     while ctran
+                     for node = (ctran-next ctran)
                      do (record-node-xrefs node functional))
                ;; Properly record the deferred macroexpansion information
                ;; that's been stored in the block.
@@ -81,7 +80,7 @@
 (defun record-node-xrefs (node context)
   (declare (type node node))
   (etypecase node
-    ((or creturn cif entry mv-combination cast))
+    ((or creturn cif entry mv-combination cast exit))
     (combination
      ;; Record references to globals made using SYMBOL-VALUE.
      (let ((fun (principal-lvar-use (combination-fun node)))
diff --git a/version.lisp-expr b/version.lisp-expr
index bc33dd9..a4b797b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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.14.1"
+"1.0.14.2"