From 69018386b391f17fb722a4ded00474be182db355 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Fri, 7 Jun 2013 19:36:13 -0400 Subject: [PATCH] More identity folding for LOGAND and LOGIOR with constants * Handle more complex cases than only powers of two: compare the variant argument with a power-of-two-sized prefix of the constant bit pattern. * Add parallel logic for LOGIOR: if all the ones we're ORing in are already set because the variant argument is a small enough negative integer, we've got an identity. * This is a bit hairy, so exhaustively check the logic with small values. --- NEWS | 1 + src/compiler/srctran.lisp | 25 +++++++++++++++++++------ tests/arith.pure.lisp | 20 ++++++++++++++++++++ 3 files changed, 40 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index b23e3ee..ba7dcd9 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,7 @@ changes relative to sbcl-1.1.8: conditionals. * optimization: bitwise OR forms can now trigger modular arithmetic as well, when the result is known to be negative. + * optimization: recognize more cases of useless LOGAND/LOGIOR with constants. * bug fix: problems with NCONC type derivation (reported by Jerry James). * bug fix: EXPT type derivation no longer constructs bogus floating-point types. (reported by Vsevolod Dyomkin) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index d408fa3..7c7f8fd 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3401,14 +3401,17 @@ (def logxor -1 (lognot x)) (def logxor 0 x)) +(defun least-zero-bit (x) + (and (/= x -1) + (1- (integer-length (logxor x (1+ x)))))) + (deftransform logand ((x y) (* (constant-arg t)) *) "fold identity operation" - (let ((y (lvar-value y))) - (unless (and (plusp y) - (= y (1- (ash 1 (integer-length y))))) - (give-up-ir1-transform)) - (unless (csubtypep (lvar-type x) - (specifier-type `(integer 0 ,y))) + (let* ((y (lvar-value y)) + (width (or (least-zero-bit y) '*))) + (unless (and (neq width 0) ; (logand x 0) handled elsewhere + (csubtypep (lvar-type x) + (specifier-type `(unsigned-byte ,width)))) (give-up-ir1-transform)) 'x)) @@ -3419,6 +3422,16 @@ (give-up-ir1-transform)) 'x)) +(deftransform logior ((x y) (* (constant-arg t)) *) + "fold identity operation" + (let* ((y (lvar-value y)) + (width (or (least-zero-bit (lognot y)) + (give-up-ir1-transform)))) ; (logior x 0) handled elsewhere + (unless (csubtypep (lvar-type x) + (specifier-type `(integer ,(- (ash 1 width)) -1))) + (give-up-ir1-transform)) + 'x)) + ;;; Pick off easy association opportunities for constant folding. ;;; More complicated stuff that also depends on commutativity ;;; (e.g. (f (f x k1) (f y k2)) => (f (f x y) (f k1 k2))) should diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index 8281d7e..32cff23 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -608,3 +608,23 @@ (the (integer 21371810342718833225 21371810343571293860) b)))) 16779072918521075607 21371810342718833263) 2923729245085762055))) + +(with-test (:name :complicated-logand-identity) + (loop for k from -8 upto 8 do + (loop for min from -16 upto 16 do + (loop for max from min upto 16 do + (let ((f (compile nil `(lambda (x) + (declare (type (integer ,min ,max) x)) + (logand x ,k))))) + (loop for x from min upto max do + (assert (eql (logand x k) (funcall f x))))))))) + +(with-test (:name :complicated-logior-identity) + (loop for k from -8 upto 8 do + (loop for min from -16 upto 16 do + (loop for max from min upto 16 do + (let ((f (compile nil `(lambda (x) + (declare (type (integer ,min ,max) x)) + (logior x ,k))))) + (loop for x from min upto max do + (assert (eql (logior x k) (funcall f x))))))))) -- 1.7.10.4