0.7.3.6:

	merged APD bug 147 fix (sbcl-devel 2002-04-27)

diff --git a/BUGS b/BUGS
index 59f4279..fc576e0 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1134,54 +1134,6 @@ WORKAROUND:
   It should be possible to be much more specific (overflow, division
   by zero, etc.) and of course the "How can this be?" should be fixable.
 
   It should be possible to be much more specific (overflow, division
   by zero, etc.) and of course the "How can this be?" should be fixable.
 

-147:
-  (reported by Alexey Dejneka sbcl-devel 2002-01-28)
-  Compiling a file containing
-    (deftype digit () '(member #\1))
-    (defun parse-num (string ind)
-      (flet ((digs ()
-               (let (old-index)
-                 (if (and (< ind ind)
-                          (typep (char string ind) 'digit))
-                     nil))))))
-  in sbcl-0.7.1 causes the compiler to fail with
-    internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" 
-  This problem seems to have been introduced by the sbcl-0.pre7.* compiler
-  changes, since 0.pre7.73 and 0.6.13 don't suffer from it. A related
-  test case is
-    (defun parse-num (index)
-      (let (num x)
-        (flet ((digs ()
-                 (setq num index))
-               (z ()
-                 (let ()
-                   (setq x nil))))
-          (when (and (digs) (digs)) x))))
-  In sbcl-0.7.1, this second test case failed with the same
-    internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" 
-  After the APD patches in sbcl-0.7.1.2 (new consistency check in
-  TARGET-IF-DESIRABLE, plus a fix in meta-vmdef.lisp to keep the
-  new consistency check from failing routinely) this second test case
-  failed in FIND-IN-PHYSENV instead. Fixes in sbcl-0.7.1.3 (not
-  closing over unreferenced variables) made this second test case
-  compile without error, but the original test case still fails.
- 
-  Another way to get rid of the DEFTYPE without changing the symptom
-  of the bug is
-    (defvar *ch*)
-    (defun parse-num (string ind)
-      (flet ((digs ()
-               (let ()
-                 (if (and (< ind ind)
-                         (sb-int:memq *ch* '(#\1)))
-                     nil))))))
-  In sbcl-0.7.1.3, this fails with
-    internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" 
-  The problem occurs while the inline expansion of MEMQ,
-  #<LAMBDA :%DEBUG-NAME "varargs entry point for SB-C::.ANONYMOUS.">
-  is being LET-converted after having its second REF deleted, leaving
-  it with only one entry in LEAF-REFS.
-  

 148:
   In sbcl-0.7.1.3 on x86, COMPILE-FILE on the file
     (in-package :cl-user)
 148:
   In sbcl-0.7.1.3 on x86, COMPILE-FILE on the file
     (in-package :cl-user)

diff --git a/NEWS b/NEWS
index 6986cc1..6d6f336 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1102,6 +1102,11 @@ changes in sbcl-0.7.3 relative to sbcl-0.7.2:
     default supplied-p) for &optional and &key arguments. (thanks to
     Martin Atzmueller)
 
     default supplied-p) for &optional and &key arguments. (thanks to
     Martin Atzmueller)
 

+changes in sbcl-0.7.4 relative to sbcl-0.7.3:
+  * bug 147 fixed: The compiler preserves its block link/count
+    invariants more correctly now so that it doesn't crash. (thanks
+    to Alexey Dejneka)
+

 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe
   later, it might impact TRACE. They both encapsulate functions, and
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe
   later, it might impact TRACE. They both encapsulate functions, and

diff --git a/README b/README
index f07d4cf..5fed77a 100644 (file)
--- a/README
+++ b/README
@@ -27,11 +27,13 @@ system, please send mail to one of the mailing lists:
 SYSTEM-SPECIFIC HINTS
 
 for OpenBSD:
 SYSTEM-SPECIFIC HINTS
 
 for OpenBSD:

-  It's reported for CMU CL (by Darren Bane on the comp.lang.lisp newsgroup,
-  2002-04-22) that OpenBSD 3.0 has stricter ulimit values, and/or enforces
-  them more strictly, than its predecessors, and so CMU CL's initial mmap()
-  won't work unless you increase the limit on the data segment, e.g. with
-    ulimit -S -d 524288
-  before you run CMU CL. The same is probably true of SBCL, but hasn't been
-  tested yet. (As of sbcl-0.7.3, SBCL has only been tested on OpenBSD 2.9
-  and earlier.)
+  OpenBSD 3.0 has stricter ulimit values, and/or enforces them more
+  strictly, than its predecessors. Therefore SBCL's initial mmap()
+  won't work unless you increase the limit on the data segment from
+  the OpenBSD defaults, e.g. with
+    ulimit -S -d 1000000
+  before you run SBCL. Otherwise SBCL fails with a message like
+  "ensure_space: failed to validate xxxxxxx bytes at yyyyy". (SBCL
+  is just allocating this huge address space, not actually using this
+  huge memory at this point. OpenBSD <3.0 had no problem with this,
+  but OpenBSD 3.0 is less hospitable.)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 66df637..3572089 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -239,15 +239,27 @@
   (do-blocks (block component)
     (cond
      ((or (block-delete-p block)
   (do-blocks (block component)
     (cond
      ((or (block-delete-p block)

-         (null (block-pred block))
-         (eq (functional-kind (block-home-lambda block)) :deleted))
+         (null (block-pred block)))

       (delete-block block))
       (delete-block block))

+     ((eq (functional-kind (block-home-lambda block)) :deleted)
+      ;; Preserve the BLOCK-SUCC invariant that almost every block has
+      ;; one successor (and a block with DELETE-P set is an acceptable
+      ;; exception).
+      (labels ((mark-blocks (block)
+                 (dolist (pred (block-pred block))
+                   (when (and (not (block-delete-p pred))
+                              (eq (functional-kind (block-home-lambda pred))
+                                  :deleted))
+                     (setf (block-delete-p pred) t)
+                     (mark-blocks pred)))))
+        (mark-blocks block)
+        (delete-block block)))

      (t
       (loop
        (let ((succ (block-succ block)))
          (unless (and succ (null (rest succ)))
            (return)))
      (t
       (loop
        (let ((succ (block-succ block)))
          (unless (and succ (null (rest succ)))
            (return)))

-       
+

        (let ((last (block-last block)))
          (typecase last
            (cif
        (let ((last (block-last block)))
          (typecase last
            (cif

@@ -257,8 +269,8 @@
            (exit
             (when (maybe-delete-exit last)
               (return)))))
            (exit
             (when (maybe-delete-exit last)
               (return)))))

-       
-       (unless (join-successor-if-possible block)
+
+        (unless (join-successor-if-possible block)

          (return)))
 
       (when (and (block-reoptimize block) (block-component block))
          (return)))
 
       (when (and (block-reoptimize block) (block-component block))

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 2e1d354..df17ebd 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -877,7 +877,14 @@
        (reoptimize-continuation cont)))
 
   (dolist (b (block-pred block))
        (reoptimize-continuation cont)))
 
   (dolist (b (block-pred block))

-    (unlink-blocks b block))
+    (unlink-blocks b block)
+    ;; In bug 147 the almost-all-blocks-have-a-successor invariant was
+    ;; broken when successors were deleted without setting the
+    ;; BLOCK-DELETE-P flags of their predececessors. Make sure that
+    ;; doesn't happen again.
+    (aver (not (and (null (block-succ b))
+                    (not (block-delete-p b))
+                    (not (eq b (component-head (block-component b))))))))

   (dolist (b (block-succ block))
     (unlink-blocks block b))
 
   (dolist (b (block-succ block))
     (unlink-blocks block b))
 

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 459e522..ce7ef42 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -77,6 +77,17 @@
 (defun bug150-test2 ()
   (let ()
     (<)))
 (defun bug150-test2 ()
   (let ()
     (<)))

+
+;;; bug 147, fixed by APD 2002-04-28
+;;;
+;;; This test case used to crash the compiler, e.g. with
+;;;   failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)"
+(defun bug147 (string ind)
+  (flet ((digs ()
+           (let (old-index)
+            (if (and (< ind ind)
+                     (typep (char string ind) '(member #\1)))
+                nil))))))

 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

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

-"0.7.3.5"
+"0.7.3.6"