0.7.10.4:

        Second try on the bug 115: convert :DEBUG-ENVIRONMENT to
        :ENVIRONMENT TN in its native environment. This is not
        efficient, but should not cause any new bugs.

BUGS

@@ -502,56 +502,6 @@ 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.
@@ -1322,29 +1272,6 @@ WORKAROUND:
   (the LOCALY there is not a typo; any unknown function (e.g. FROB)
   will do).
 
-226: "AVER failure in COMPILE-FILE of clocc-ansi-test/tests.lisp"
-  (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)))))))
-
-227: "compiler bewilderment with adjustable vectors and COPY-SEQ"
-  (fixed in sbcl-0.7.9.65)
-
 228: "function-lambda-expression problems"
   in sbcl-0.7.9.6x, from the REPL:
     * (progn (declaim (inline foo)) (defun foo (x) x))
@@ -1357,6 +1284,12 @@ WORKAROUND:
 229:
   (subtypep 'function '(function)) => nil, t.
 
+230:
+  (char= #\a "a") => nil.
+
+  DAA requires it to signal a type error.
+
+
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
     These labels were used for bugs related to the old IR1 interpreter.

src/compiler/life.lisp

@@ -124,7 +124,7 @@
 		  (unless (tn-global-conflicts tn)
 		    (convert-to-global tn))
 		  (add-global-conflict :read-only tn block ltn-num))
-		
+
 		(setf (tn-local tn) block)
 		(setf (tn-local-number tn) ltn-num)
 		(setf (svref tns ltn-num) tn)
@@ -217,7 +217,7 @@
 ;;; local when we scan the block again.
 ;;;
 ;;; If there are conflicts, then we set LOCAL to one of the
-;;; conflicting blocks. This ensures that Local doesn't hold over
+;;; conflicting blocks. This ensures that LOCAL doesn't hold over
 ;;; BLOCK as its value, causing the subsequent reanalysis to think
 ;;; that the TN has already been seen in that block.
 ;;;
@@ -444,14 +444,16 @@
 (defun convert-to-environment-tn (tn tn-physenv)
   (declare (type tn tn) (type physenv tn-physenv))
   (aver (member (tn-kind tn) '(:normal :debug-environment)))
-  (when (eq (tn-kind tn) :debug-environment)
-    (aver (eq (tn-physenv tn) tn-physenv))
-    (let ((2env (physenv-info tn-physenv)))
-      (setf (ir2-physenv-debug-live-tns 2env)
-	    (delete tn (ir2-physenv-debug-live-tns 2env)))))
+  (ecase (tn-kind tn)
+    (:debug-environment
+     (setq tn-physenv (tn-physenv tn))
+     (let* ((2env (physenv-info tn-physenv)))
+       (setf (ir2-physenv-debug-live-tns 2env)
+             (delete tn (ir2-physenv-debug-live-tns 2env)))))
+    (:normal
+     (setf (tn-local tn) nil)
+     (setf (tn-local-number tn) nil)))
   (setup-environment-tn-conflicts *component-being-compiled* tn tn-physenv nil)
-  (setf (tn-local tn) nil)
-  (setf (tn-local-number tn) nil)
   (setf (tn-kind tn) :environment)
   (setf (tn-physenv tn) tn-physenv)
   (push tn (ir2-physenv-live-tns (physenv-info tn-physenv)))

src/compiler/vop.lisp

@@ -150,8 +150,8 @@
   (local-tns (make-array local-tn-limit) :type local-tn-vector)
   ;; Bit-vectors used during lifetime analysis to keep track of
   ;; references to local TNs. When indexed by the LTN number, the
-  ;; index for a TN is non-zero in Written if it is ever written in
-  ;; the block, and in Live-Out if the first reference is a read.
+  ;; index for a TN is non-zero in WRITTEN if it is ever written in
+  ;; the block, and in LIVE-OUT if the first reference is a read.
   (written (make-array local-tn-limit :element-type 'bit
 		       :initial-element 0)
 	   :type local-tn-bit-vector)

tests/compiler-1.impure-cload.lisp

@@ -138,5 +138,39 @@
           #'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
 

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.10.3"
+"0.7.10.4"