From a080d7c4a2690d01e334bfa81a0375384a0f2dac Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 22 Apr 2003 04:42:18 +0000 Subject: [PATCH] 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. --- NEWS | 1 + src/compiler/fndb.lisp | 2 +- src/compiler/ir1opt.lisp | 47 +++++++++++++++++++++++++++------------------- version.lisp-expr | 2 +- 4 files changed, 31 insertions(+), 21 deletions(-) diff --git a/NEWS b/NEWS index 0ac4b8e..2aae548 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4