0.pre8.89:

        * CAST branch seems to take too long time to complete, so:
        ** fixed ENDP.* tests from Paul Dietz' test suit by disabling
          "constant folding" and flushing of IF;
        * fixed type declaration for ENDP as recommended by CSR;
        * ... and ENDP is FLUSHABLE.

diff --git a/NEWS b/NEWS
index 0ac4b8e..2aae548 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1689,6 +1689,7 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
        arguments contain duplicated elements;
     ** RESTART-CASE understands local macros;
     ** ... and associates exactly its own restarts with a condition;
+    ** ENDP in safe mode checks its argument to be of type LIST;
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 58e3c77..80c5a7a 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -676,7 +676,7 @@
 
 (defknown tree-equal (t t &key (:test callable) (:test-not callable)) boolean
   (foldable flushable call))
-(defknown endp (t) boolean (foldable unsafely-flushable movable))
+(defknown endp (list) boolean (foldable flushable movable))
 (defknown list-length (list) (or index null) (foldable unsafely-flushable))
 (defknown nth (index list) t (foldable flushable))
 (defknown nthcdr (index list) t (foldable unsafely-flushable))

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 640468e..2ffc385 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -317,9 +317,15 @@
           (let ((last (block-last block)))
             (typecase last
               (cif
-               (flush-dest (if-test last))
-               (when (unlink-node last)
-                 (return)))
+               (if (memq (continuation-type-check (if-test last))
+                         '(nil :deleted))
+                   ;; FIXME: Remove the test above when the bug 203
+                   ;; will be fixed.
+                   (progn
+                     (flush-dest (if-test last))
+                     (when (unlink-node last)
+                       (return)))
+                   (return)))
               (exit
                (when (maybe-delete-exit last)
                  (return)))))
@@ -633,22 +639,25 @@
          (convert-if-if use node)
          (when (continuation-use test) (return)))))
 
-    (let* ((type (continuation-type test))
-          (victim
-           (cond ((constant-continuation-p test)
-                  (if (continuation-value test)
-                      (if-alternative node)
-                      (if-consequent node)))
-                 ((not (types-equal-or-intersect type (specifier-type 'null)))
-                  (if-alternative node))
-                 ((type= type (specifier-type 'null))
-                  (if-consequent node)))))
-      (when victim
-       (flush-dest test)
-       (when (rest (block-succ block))
-         (unlink-blocks block victim))
-       (setf (component-reanalyze (node-component node)) t)
-       (unlink-node node))))
+    (when (memq (continuation-type-check test)
+                '(nil :deleted))
+      ;; FIXME: Remove the test above when the bug 203 will be fixed.
+      (let* ((type (continuation-type test))
+             (victim
+              (cond ((constant-continuation-p test)
+                     (if (continuation-value test)
+                         (if-alternative node)
+                         (if-consequent node)))
+                    ((not (types-equal-or-intersect type (specifier-type 'null)))
+                     (if-alternative node))
+                    ((type= type (specifier-type 'null))
+                     (if-consequent node)))))
+        (when victim
+          (flush-dest test)
+          (when (rest (block-succ block))
+            (unlink-blocks block victim))
+          (setf (component-reanalyze (node-component node)) t)
+          (unlink-node node)))))
   (values))
 
 ;;; Create a new copy of an IF node that tests the value of the node

diff --git a/version.lisp-expr b/version.lisp-expr
index ea14eb0..83ef7d0 100644 (file)
--- 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".)
-"0.pre8.88"
+"0.pre8.89"