From 600211043a4b973e4c525511b44d9cc7a5907676 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Tue, 12 Oct 2010 04:43:48 +0000 Subject: [PATCH] 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. --- src/compiler/ir1opt.lisp | 29 ++++++++++++++++++++++++----- version.lisp-expr | 2 +- 2 files changed, 25 insertions(+), 6 deletions(-) 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" -- 1.7.10.4