| ... |
... |
@@ -1443,59 +1443,20 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps |
|
1443
|
1443
|
)
|
|
1444
|
1444
|
|
|
1445
|
1445
|
-- Use the bit-test instructions btr/bts/btc for clearing, setting and
|
|
1446
|
|
--- complementing a single, variable bit: e.g. x .&. complement (1 `shiftL` i)
|
|
1447
|
|
--- is btr. See Note [Bit-test instructions].
|
|
1448
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_And w) [x, CmmMachOp (MO_Not _) [y]])
|
|
1449
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1450
|
|
- = genBitTestCode (intFormat w) BTR x i
|
|
1451
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_And w) [CmmMachOp (MO_Not _) [y], x])
|
|
1452
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1453
|
|
- = genBitTestCode (intFormat w) BTR x i
|
|
1454
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_Or w) [x, y])
|
|
1455
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1456
|
|
- = genBitTestCode (intFormat w) BTS x i
|
|
1457
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_Or w) [y, x])
|
|
1458
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1459
|
|
- = genBitTestCode (intFormat w) BTS x i
|
|
1460
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_Xor w) [x, y])
|
|
1461
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1462
|
|
- = genBitTestCode (intFormat w) BTC x i
|
|
1463
|
|
-getRegister' _ is32Bit (CmmMachOp (MO_Xor w) [y, x])
|
|
1464
|
|
- | Just i <- singleBit_maybe y, bitTestOpWidthOK is32Bit w
|
|
1465
|
|
- = genBitTestCode (intFormat w) BTC x i
|
|
1466
|
|
-
|
|
1467
|
|
--- The same operations with a literal bit index: constant folding has turned
|
|
1468
|
|
--- the mask itself into a literal, so use a bit-test instruction whenever the
|
|
1469
|
|
--- mask does not fit in an imm32. See Note [Bit-test instructions].
|
|
1470
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_And w) [x, CmmLit lit@(CmmInt m _)])
|
|
1471
|
|
- | Just i <- clearBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1472
|
|
- , not (is32BitLit platform lit)
|
|
1473
|
|
- = genBitTestImmCode (intFormat w) BTR x i
|
|
1474
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_Or w) [x, CmmLit lit@(CmmInt m _)])
|
|
1475
|
|
- | Just i <- setBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1476
|
|
- , not (is32BitLit platform lit)
|
|
1477
|
|
- = genBitTestImmCode (intFormat w) BTS x i
|
|
1478
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_Xor w) [x, CmmLit lit@(CmmInt m _)])
|
|
1479
|
|
- | Just i <- setBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1480
|
|
- , not (is32BitLit platform lit)
|
|
1481
|
|
- = genBitTestImmCode (intFormat w) BTC x i
|
|
1482
|
|
-
|
|
1483
|
|
--- Mirrored versions with the literal mask on the left. Constant folding
|
|
1484
|
|
--- canonicalizes constants to the right (see GHC.Cmm.Opt.cmmMachOpFoldM), so
|
|
1485
|
|
--- these only fire on Cmm that reaches the NCG unfolded, e.g. hand-written
|
|
1486
|
|
--- .cmm code.
|
|
1487
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_And w) [CmmLit lit@(CmmInt m _), x])
|
|
1488
|
|
- | Just i <- clearBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1489
|
|
- , not (is32BitLit platform lit)
|
|
1490
|
|
- = genBitTestImmCode (intFormat w) BTR x i
|
|
1491
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_Or w) [CmmLit lit@(CmmInt m _), x])
|
|
1492
|
|
- | Just i <- setBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1493
|
|
- , not (is32BitLit platform lit)
|
|
1494
|
|
- = genBitTestImmCode (intFormat w) BTS x i
|
|
1495
|
|
-getRegister' platform is32Bit (CmmMachOp (MO_Xor w) [CmmLit lit@(CmmInt m _), x])
|
|
1496
|
|
- | Just i <- setBitLit_maybe w m, bitTestOpWidthOK is32Bit w
|
|
1497
|
|
- , not (is32BitLit platform lit)
|
|
1498
|
|
- = genBitTestImmCode (intFormat w) BTC x i
|
|
|
1446
|
+-- complementing a single bit: e.g. x .&. complement (1 `shiftL` i) is btr.
|
|
|
1447
|
+-- See Note [Bit-test instructions].
|
|
|
1448
|
+getRegister' platform is32Bit (CmmMachOp (MO_And w) [x, y])
|
|
|
1449
|
+ | bitTestOpWidthOK is32Bit w
|
|
|
1450
|
+ , Just (opnd, ix) <- clearBitArgs_maybe platform w x y
|
|
|
1451
|
+ = genBitTestCode (intFormat w) BTR opnd ix
|
|
|
1452
|
+getRegister' platform is32Bit (CmmMachOp (MO_Or w) [x, y])
|
|
|
1453
|
+ | bitTestOpWidthOK is32Bit w
|
|
|
1454
|
+ , Just (opnd, ix) <- setBitArgs_maybe platform w x y
|
|
|
1455
|
+ = genBitTestCode (intFormat w) BTS opnd ix
|
|
|
1456
|
+getRegister' platform is32Bit (CmmMachOp (MO_Xor w) [x, y])
|
|
|
1457
|
+ | bitTestOpWidthOK is32Bit w
|
|
|
1458
|
+ , Just (opnd, ix) <- setBitArgs_maybe platform w x y
|
|
|
1459
|
+ = genBitTestCode (intFormat w) BTC opnd ix
|
|
1499
|
1460
|
|
|
1500
|
1461
|
getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
|
|
1501
|
1462
|
sse4_1 <- sse4_1Enabled
|
| ... |
... |
@@ -5998,14 +5959,62 @@ clearBitLit_maybe w m = setBitLit_maybe w (complement m) |
|
5998
|
5959
|
bitTestOpWidthOK :: Bool -> Width -> Bool
|
|
5999
|
5960
|
bitTestOpWidthOK is32Bit w = w == W32 || (w == W64 && not is32Bit)
|
|
6000
|
5961
|
|
|
|
5962
|
+-- | The bit-offset operand of a bit-test instruction (btr/bts/btc).
|
|
|
5963
|
+data BitIndex
|
|
|
5964
|
+ = BitIndexReg CmmExpr -- ^ variable index, computed into a register
|
|
|
5965
|
+ | BitIndexImm Int -- ^ literal index, emitted as an immediate
|
|
|
5966
|
+
|
|
|
5967
|
+-- | Match the operands of a single-bit set or complement operation: one
|
|
|
5968
|
+-- operand is a mask @1 << i@, or a literal with exactly one bit set that
|
|
|
5969
|
+-- does not fit in an imm32. Returns the other operand and the bit index.
|
|
|
5970
|
+--
|
|
|
5971
|
+-- Both operand orders are matched: constant folding canonicalizes literals
|
|
|
5972
|
+-- to the right (see 'GHC.Cmm.Opt.cmmMachOpFoldM'), but e.g. hand-written
|
|
|
5973
|
+-- .cmm code reaches the NCG unfolded.
|
|
|
5974
|
+--
|
|
|
5975
|
+-- See Note [Bit-test instructions].
|
|
|
5976
|
+setBitArgs_maybe :: Platform -> Width -> CmmExpr -> CmmExpr
|
|
|
5977
|
+ -> Maybe (CmmExpr, BitIndex)
|
|
|
5978
|
+setBitArgs_maybe platform w x y = go x y `mplus` go y x
|
|
|
5979
|
+ where
|
|
|
5980
|
+ go opnd mask
|
|
|
5981
|
+ | Just i <- singleBit_maybe mask
|
|
|
5982
|
+ = Just (opnd, BitIndexReg i)
|
|
|
5983
|
+ | CmmLit lit@(CmmInt m _) <- mask
|
|
|
5984
|
+ , Just i <- setBitLit_maybe w m
|
|
|
5985
|
+ , not (is32BitLit platform lit)
|
|
|
5986
|
+ = Just (opnd, BitIndexImm i)
|
|
|
5987
|
+ | otherwise
|
|
|
5988
|
+ = Nothing
|
|
|
5989
|
+
|
|
|
5990
|
+-- | As 'setBitArgs_maybe', for a single-bit clear operation: the mask is
|
|
|
5991
|
+-- @~(1 << i)@, or a literal with exactly one bit clear.
|
|
|
5992
|
+clearBitArgs_maybe :: Platform -> Width -> CmmExpr -> CmmExpr
|
|
|
5993
|
+ -> Maybe (CmmExpr, BitIndex)
|
|
|
5994
|
+clearBitArgs_maybe platform w x y = go x y `mplus` go y x
|
|
|
5995
|
+ where
|
|
|
5996
|
+ go opnd mask
|
|
|
5997
|
+ | CmmMachOp (MO_Not _) [b] <- mask
|
|
|
5998
|
+ , Just i <- singleBit_maybe b
|
|
|
5999
|
+ = Just (opnd, BitIndexReg i)
|
|
|
6000
|
+ | CmmLit lit@(CmmInt m _) <- mask
|
|
|
6001
|
+ , Just i <- clearBitLit_maybe w m
|
|
|
6002
|
+ , not (is32BitLit platform lit)
|
|
|
6003
|
+ = Just (opnd, BitIndexImm i)
|
|
|
6004
|
+ | otherwise
|
|
|
6005
|
+ = Nothing
|
|
|
6006
|
+
|
|
6001
|
6007
|
-- | Generate code for @dst := x@ followed by a bit-test instruction
|
|
6002
|
|
--- (btr/bts/btc) with bit offset @i@.
|
|
|
6008
|
+-- (btr/bts/btc).
|
|
6003
|
6009
|
--
|
|
6004
|
|
--- Analogous to 'genTrivialCode', but the offset operand must be a register,
|
|
6005
|
|
--- not memory. See Note [Bit-test instructions].
|
|
|
6010
|
+-- See Note [Bit-test instructions].
|
|
6006
|
6011
|
genBitTestCode :: Format -> (Format -> Operand -> Operand -> Instr)
|
|
6007
|
|
- -> CmmExpr -> CmmExpr -> NatM Register
|
|
6008
|
|
-genBitTestCode rep instr x i = do
|
|
|
6012
|
+ -> CmmExpr -> BitIndex -> NatM Register
|
|
|
6013
|
+genBitTestCode rep instr x (BitIndexImm i) = do
|
|
|
6014
|
+ x_code <- getAnyReg x
|
|
|
6015
|
+ let code dst = x_code dst `snocOL` instr rep (OpImm (ImmInt i)) (OpReg dst)
|
|
|
6016
|
+ return (Any rep code)
|
|
|
6017
|
+genBitTestCode rep instr x (BitIndexReg i) = do
|
|
6009
|
6018
|
(i_reg, i_code) <- getNonClobberedReg i
|
|
6010
|
6019
|
x_code <- getAnyReg x
|
|
6011
|
6020
|
tmp <- getNewRegNat rep
|
| ... |
... |
@@ -6024,17 +6033,6 @@ genBitTestCode rep instr x i = do |
|
6024
|
6033
|
instr rep (OpReg i_reg) (OpReg dst)
|
|
6025
|
6034
|
return (Any rep code)
|
|
6026
|
6035
|
|
|
6027
|
|
--- | Generate code for @dst := x@ followed by a bit-test instruction
|
|
6028
|
|
--- (btr/bts/btc) with an immediate bit offset.
|
|
6029
|
|
---
|
|
6030
|
|
--- See Note [Bit-test instructions].
|
|
6031
|
|
-genBitTestImmCode :: Format -> (Format -> Operand -> Operand -> Instr)
|
|
6032
|
|
- -> CmmExpr -> Int -> NatM Register
|
|
6033
|
|
-genBitTestImmCode rep instr x i = do
|
|
6034
|
|
- x_code <- getAnyReg x
|
|
6035
|
|
- let code dst = x_code dst `snocOL` instr rep (OpImm (ImmInt i)) (OpReg dst)
|
|
6036
|
|
- return (Any rep code)
|
|
6037
|
|
-
|
|
6038
|
6036
|
regClashesWithOp :: Reg -> Operand -> Bool
|
|
6039
|
6037
|
reg `regClashesWithOp` OpReg reg2 = reg == reg2
|
|
6040
|
6038
|
reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)
|