diff options
-rw-r--r-- | src/compiler/x86-64/arith.lisp | 58 |
1 files changed, 41 insertions, 17 deletions
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 90f5166e1..35a5e2d23 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -227,29 +227,50 @@ ;; when Y = (ldb (byte 32 0) (fixnumize -1 n-fixnum-tag-bits)) ;; Probably not very common, so not too important. (inst and :dword r y)) - (t - (move r x) - (inst and r (constantize y)))))) + (t + (move r x) + (inst and r (constantize y)))))) :c/unsigned=>unsigned ;; Probably should give it the preceding treatment here too. ;; Also, if the constant is #xFFFFFFFF, then just a MOV is enough ;; if the destination is a register. ((move r x) - (let ((y (constantize y))) - ;; ANDing with #xFFFF_FFFF_FFFF_FFFF is a no-op, other than - ;; the eflags state which we don't care about. - (unless (eql y -1) ; do nothing if this is true - (inst and r y))))) + ;; ANDing with #xFFFF_FFFF_FFFF_FFFF is a no-op, other than + ;; the eflags state which we don't care about. + (cond ((eql y -1)) + ((and (not (plausible-signed-imm32-operand-p y)) + (= (logcount (logandc1 y most-positive-word)) 1)) + (inst btr r (1- (integer-length (logandc1 y most-positive-word))))) + (t + (inst and r (constantize y)))))) (define-binop logior 2 or - :c/unsigned=>unsigned - ((let ((y (constantize y))) - (cond ((and (gpr-tn-p r) (eql y -1)) ; special-case "OR reg, all-ones" - ;; I have yet to elicit this case. Can it happen? - (inst mov r -1)) + :c/fixnum=>fixnum + ((let ((y (fixnumize y))) + (move r x) + (cond ((and (not (plausible-signed-imm32-operand-p y)) + (= (logcount y) 1)) + (inst bts r (1- (integer-length y)))) (t - (move r x) - (inst or r y)))))) + (inst or r (constantize y)))))) + :c/unsigned=>unsigned + ((cond ((and (gpr-tn-p r) (eql y -1)) ; special-case "OR reg, all-ones" + ;; I have yet to elicit this case. Can it happen? + (inst mov r -1)) + ((and (not (plausible-signed-imm32-operand-p y)) + (= (logcount y) 1)) + (move r x) + (inst bts r (1- (integer-length y)))) + (t + (move r x) + (inst or r (constantize y))))) + :c/signed=>signed + ((move r x) + (cond ((and (not (plausible-signed-imm32-operand-p y)) + (= (logcount y) 1)) + (inst bts r (1- (integer-length y)))) + (t + (inst or r (constantize y)))))) (define-binop logxor 2 xor :c/unsigned=>unsigned @@ -3870,8 +3891,11 @@ DONE (unless (or fixnum-mask-p (= mask most-positive-word)) - (inst and r (or (plausible-signed-imm32-operand-p mask) - (constantize mask)))))))) + (if (and (not (plausible-signed-imm32-operand-p mask)) + (= (logcount (logandc1 mask most-positive-word)) 1)) + (inst btr r (1- (integer-length (logandc1 mask most-positive-word)))) + (inst and r (or (plausible-signed-imm32-operand-p mask) + (constantize mask))))))))) (in-package "SB-C") |