From: Paul Khuong Date: Tue, 12 Oct 2010 04:43:48 +0000 (+0000) Subject: 1.0.43.43: Merge more equivalent branches together X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=600211043a4b973e4c525511b44d9cc7a5907676;p=sbcl.git 1.0.43.43: Merge more equivalent branches together * Recognize cases of (if foo [leaf] [same leaf]), and compile the conditional branch away. We used to only perform something similar to that when the branches jumped to exactly the same block. We now detect simple cases of equivalent blocks. --- diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index bbcdc89..5e53ea3 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -635,24 +635,43 @@ ;;;; IF optimization +;;; Utility: return T if both argument cblocks are equivalent. For now, +;;; detect only blocks that read the same leaf into the same lvar, and +;;; continue to the same block. +(defun cblocks-equivalent-p (x y) + (declare (type cblock x y)) + (and (ref-p (block-start-node x)) + (eq (block-last x) (block-start-node x)) + + (ref-p (block-start-node y)) + (eq (block-last y) (block-start-node y)) + + (equal (block-succ x) (block-succ y)) + (eql (ref-lvar (block-start-node x)) (ref-lvar (block-start-node y))) + (eql (ref-leaf (block-start-node x)) (ref-leaf (block-start-node y))))) + ;;; Check whether the predicate is known to be true or false, ;;; deleting the IF node in favor of the appropriate branch when this ;;; is the case. +;;; Similarly, when both branches are equivalent, branch directly to either +;;; of them. ;;; Also, if the test has multiple uses, replicate the node when possible. (defun ir1-optimize-if (node) (declare (type cif node)) (let ((test (if-test node)) (block (node-block node))) (let* ((type (lvar-type test)) + (consequent (if-consequent node)) + (alternative (if-alternative node)) (victim (cond ((constant-lvar-p test) - (if (lvar-value test) - (if-alternative node) - (if-consequent node))) + (if (lvar-value test) alternative consequent)) ((not (types-equal-or-intersect type (specifier-type 'null))) - (if-alternative node)) + alternative) ((type= type (specifier-type 'null)) - (if-consequent node))))) + consequent) + ((cblocks-equivalent-p alternative consequent) + alternative)))) (when victim (flush-dest test) (when (rest (block-succ block)) diff --git a/version.lisp-expr b/version.lisp-expr index 8fe4b2d..4caedee 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".) -"1.0.43.42" +"1.0.43.43"