[Sbcl-commits] CVS: sbcl/src/compiler life.lisp,1.11,1.12

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv23866/src/compiler

Modified Files:
	life.lisp 
Log Message:
0.7.9.60:
        Undone patch from 0.7.9.54 for bugs 115 and 226.


Index: life.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/life.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- life.lisp	18 Nov 2002 05:52:19 -0000	1.11
+++ life.lisp	21 Nov 2002 14:36:06 -0000	1.12
@@ -483,47 +483,41 @@
 ;;; We leave the CURRENT-CONFLICT pointing to the conflict for BLOCK1.
 ;;; The CURRENT-CONFLICT must be initialized to the head of the
 ;;; GLOBAL-CONFLICTS for the TN between each flow analysis iteration.
-;;;
-;;; :DEBUG-ENVIRONMENT TN might be :LIVE before being assigned, so we
-;;; must be careful to not propagate its liveness into another
-;;; environment (see bug 115).
 (defun propagate-live-tns (block1 block2)
   (declare (type ir2-block block1 block2))
   (let ((live-in (ir2-block-live-in block1))
 	(did-something nil))
     (do ((conf2 (ir2-block-global-tns block2)
-                (global-conflicts-next-blockwise conf2)))
-        ((null conf2))
-      (let ((tn (global-conflicts-tn conf2)))
-        (unless (and (not (eq (ir2-block-physenv block1) (ir2-block-physenv block2)))
-                     (member (tn-kind tn) '(:environment :debug-environment)))
-          (ecase (global-conflicts-kind conf2)
-            ((:live :read :read-only)
-             (let* ((tn-conflicts (tn-current-conflict tn))
-                    (number1 (ir2-block-number block1)))
-               (aver tn-conflicts)
-               (do ((current tn-conflicts (global-conflicts-next-tnwise current))
-                    (prev nil current))
-                   ((or (null current)
-                        (> (ir2-block-number (global-conflicts-block current))
-                           number1))
-                    (setf (tn-current-conflict tn) prev)
-                    (add-global-conflict :live tn block1 nil)
-                    (setq did-something t))
-                 (when (eq (global-conflicts-block current) block1)
-                   (case (global-conflicts-kind current)
-                     (:live)
-                     (:read-only
-                      (setf (global-conflicts-kind current) :live)
-                      (setf (svref (ir2-block-local-tns block1)
-                                   (global-conflicts-number current))
-                            nil)
-                      (setf (global-conflicts-number current) nil)
-                      (setf (tn-current-conflict tn) current))
-                     (t
-                      (setf (sbit live-in (global-conflicts-number current)) 1)))
-                   (return)))))
-            (:write)))))
+		(global-conflicts-next-blockwise conf2)))
+	((null conf2))
+      (ecase (global-conflicts-kind conf2)
+	((:live :read :read-only)
+	 (let* ((tn (global-conflicts-tn conf2))
+		(tn-conflicts (tn-current-conflict tn))
+		(number1 (ir2-block-number block1)))
+	   (aver tn-conflicts)
+	   (do ((current tn-conflicts (global-conflicts-next-tnwise current))
+		(prev nil current))
+	       ((or (null current)
+		    (> (ir2-block-number (global-conflicts-block current))
+		       number1))
+		(setf (tn-current-conflict tn) prev)
+		(add-global-conflict :live tn block1 nil)
+		(setq did-something t))
+	     (when (eq (global-conflicts-block current) block1)
+	       (case (global-conflicts-kind current)
+		 (:live)
+		 (:read-only
+		  (setf (global-conflicts-kind current) :live)
+		  (setf (svref (ir2-block-local-tns block1)
+			       (global-conflicts-number current))
+			nil)
+		  (setf (global-conflicts-number current) nil)
+		  (setf (tn-current-conflict tn) current))
+		 (t
+		  (setf (sbit live-in (global-conflicts-number current)) 1)))
+	       (return)))))
+	(:write)))
     did-something))
 
 ;;; Do backward global flow analysis to find all TNs live at each