0.7.9.60:

        Undone patch from 0.7.9.54 for bugs 115 and 226.

diff --git a/BUGS b/BUGS
index fac411c..e144df9 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -502,6 +502,56 @@ WORKAROUND:
   time trying to GC afterwards. Surely there's some more economical
   way to implement (ROOM T).
 
+115:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    (in-package :cl-user)
+    ;;; The following invokes a compiler error.
+    (declaim (optimize (speed 2) (debug 3)))
+    (defun tst ()
+      (flet ((m1 ()
+               (unwind-protect nil)))
+        (if (catch nil)
+          (m1)
+          (m1))))
+  The error message in sbcl-0.6.12.42 is
+    internal error, failed AVER:
+      "(COMMON-LISP:EQ (SB!C::TN-ENVIRONMENT SB!C:TN) SB!C::TN-ENV)"
+
+  This examples better illustrates the problem:
+
+  (defun tst ()
+    (declare (optimize (speed 2) (debug 3)))
+    (flet ((m1 ()
+             (bar (if (foo) 1 2))
+             (let ((x (foo)))
+               (bar x (list x)))))
+      (if (catch nil)
+          (m1)
+          (m1))))
+
+  (X is allocated in the physical environment of M1; X is :WRITE in
+  the call of LET [convert-to-global]; IF makes sure that a block
+  exists in M1 before this call.)
+
+  Because X is :DEBUG-ENVIRONMENT, it is :LIVE by default in all
+  blocks in the environment, particularly it is :LIVE in the start of
+  M1 (where it is not yet :WRITE) [setup-environment-tn-conflicts].
+
+  Then :LIVE is propagated backwards, i.e. into the caller of M1
+  where X does not exist [lifetime-flow-analysis].
+
+  (CATCH NIL) causes all TNs to be saved; Python fails on saving
+  non-existent variable; if it is replaced with (FOO), the problem
+  appears when debugging TST: LIST-LOCALS says
+
+    debugger invoked on condition of type SB-DI:UNKNOWN-DEBUG-VAR:
+
+    #<SB-DI::COMPILED-DEBUG-VAR X 0
+      {905FF7D}> is not in #<SB-DI::COMPILED-DEBUG-FUNCTION TST>.
+
+  (in those old versions, in which debugger worked :-().
+
 117:
   When the compiler inline expands functions, it may be that different
   kinds of return values are generated from different code branches.
@@ -1272,7 +1322,24 @@ WORKAROUND:
           (ignore-errors (progn (values-list (car (list '(1 . 2)))) t)))
 
 226: "AVER failure in COMPILE-FILE of clocc-ansi-test/tests.lisp"
-  (fixed in 0.7.9.54)
+  (APD points out that this seems to be another symptom of bug #115.)
+  sbcl-0.7.9.43 dies with failed AVER "(EQ (TN-PHYSENV TN) TN-ENV)" when
+  trying to compile clocc-ansi-test/tests.lisp. sbcl-0.7.9.31 was able to
+  to compile it. A smaller test case exhibiting the same problem is
+   (declaim (optimize (speed 0) (safety 3) (debug 3)))
+   (defun c-a-p ()
+     (flet ((safe-format (stream string &rest r)
+              (unless (ignore-errors (progn
+                                       (apply #'format stream string r)
+                                       t))
+               (format stream "~&foo ~S" string))))
+       (cond
+        ((eq my-result :ERROR)
+         (cond
+          ((ignore-errors (typep condition result))
+           (safe-format t "~&bar ~S" result))
+          (t
+           (safe-format t "~&baz ~S (~A) ~S" condition condition result)))))))
 
 
 DEFUNCT CATEGORIES OF BUGS

diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp
index 3550d8f..afd27fb 100644 (file)
--- a/src/compiler/life.lisp
+++ b/src/compiler/life.lisp
@@ -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

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index bb9e300..b1b81c4 100644 (file)
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -138,39 +138,5 @@
           #'objs.stale?))
   (call-next-method))
 
-;;; bugs 115, 226: compiler failure in lifetime analysis
-(defun bug115-1 ()
-  (declare (optimize (speed 2) (debug 3)))
-  (flet ((m1 ()
-           (unwind-protect nil)))
-    (if (catch nil)
-        (m1)
-        (m1))))
-
-(defun bug115-2 ()
-  (declare (optimize (speed 2) (debug 3)))
-  (flet ((m1 ()
-           (bar (if (foo) 1 2))
-           (let ((x (foo)))
-             (bar x (list x)))))
-    (if (catch nil)
-        (m1)
-        (m1))))
-
-(defun bug226 ()
-  (declare (optimize (speed 0) (safety 3) (debug 3)))
-  (flet ((safe-format (stream string &rest r)
-           (unless (ignore-errors (progn
-                                    (apply #'format stream string r)
-                                    t))
-             (format stream "~&foo ~S" string))))
-    (cond
-      ((eq my-result :ERROR)
-       (cond
-         ((ignore-errors (typep condition result))
-          (safe-format t "~&bar ~S" result))
-         (t
-          (safe-format t "~&baz ~S (~A) ~S" condition condition result)))))))
-
-
 (sb-ext:quit :unix-status 104) ; success
+

diff --git a/version.lisp-expr b/version.lisp-expr
index 02d2641..a851108 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.59"
+"0.7.9.60"