Simon Jakobi pushed to branch wip/sjakobi/T25233 at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • compiler/GHC/CmmToAsm/X86/CodeGen.hs
    ... ... @@ -1442,6 +1442,28 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
    1442 1442 
                                         (PUNPCKLQDQ fmt (OpReg dst) dst)
    1443 1443 
                                         )
    1444 1444
    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 w') [y]])
    1449 
    +  | w == w', Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1450 
    +  = genBitTestCode (intFormat w) BTR x i
    1451 
    +getRegister' _ is32Bit (CmmMachOp (MO_And w) [CmmMachOp (MO_Not w') [y], x])
    1452 
    +  | w == w', Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1453 
    +  = genBitTestCode (intFormat w) BTR x i
    1454 
    +getRegister' _ is32Bit (CmmMachOp (MO_Or w) [x, y])
    1455 
    +  | Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1456 
    +  = genBitTestCode (intFormat w) BTS x i
    1457 
    +getRegister' _ is32Bit (CmmMachOp (MO_Or w) [y, x])
    1458 
    +  | Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1459 
    +  = genBitTestCode (intFormat w) BTS x i
    1460 
    +getRegister' _ is32Bit (CmmMachOp (MO_Xor w) [x, y])
    1461 
    +  | Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1462 
    +  = genBitTestCode (intFormat w) BTC x i
    1463 
    +getRegister' _ is32Bit (CmmMachOp (MO_Xor w) [y, x])
    1464 
    +  | Just i <- isSingleBit w y, bitTestOpWidthOK is32Bit w
    1465 
    +  = genBitTestCode (intFormat w) BTC x i
    1466 
    +
    1445 1467 
     getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
    1446 1468 
       sse4_1 <- sse4_1Enabled
    1447 1469 
       sse4_2 <- sse4_2Enabled
    ... ... @@ -5883,6 +5905,68 @@ genTrivialCode rep instr a b = do
    5883 5905 
                     instr b_op dst
    5884 5906 
       return (Any rep code)
    5885 5907
    5908 
    +{- Note [Bit-test instructions]
    5909 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    5910 
    +x86 has dedicated instructions for clearing (btr), setting (bts) and
    5911 
    +complementing (btc) a single bit whose index is given in a register.  We use
    5912 
    +them for Cmm patterns such as
    5913 
    +
    5914 
    +  x & ~(1 << i)     ==>     btr i, x       (#25233)
    5915 
    +
    5916 
    +replacing a mov/shl/not/and sequence with a single instruction.  The
    5917 
    +shift-count register operand of shl is masked modulo the operand width, and
    5918 
    +the bit-offset register operand of btr/bts/btc is masked the same way, so
    5919 
    +the replacement is faithful even for out-of-range i (where the Cmm shift is
    5920 
    +in any case undefined).
    5921 
    +
    5922 
    +The bit-offset operand of these instructions must be an immediate or a
    5923 
    +register.  We only use them when the bit index is a non-literal expression:
    5924 
    +when i is a literal, constant folding has already turned the mask into a
    5925 
    +literal, and an ordinary and/or/xor with an immediate is at least as good.
    5926 
    +
    5927 
    +We restrict the pattern to W32 and native-width W64: the instructions do not
    5928 
    +exist at width 8, and sub-word Cmm operations at W8/W16 are rare enough that
    5929 
    +they are not worth the extra care.
    5930 
    +-}
    5931 
    +
    5932 
    +-- | Match @1 << i@ with a non-literal @i@, returning @i@.
    5933 
    +-- See Note [Bit-test instructions].
    5934 
    +isSingleBit :: Width -> CmmExpr -> Maybe CmmExpr
    5935 
    +isSingleBit w (CmmMachOp (MO_Shl w') [CmmLit (CmmInt 1 _), i])
    5936 
    +  | w == w', not (isLit i) = Just i
    5937 
    +  where
    5938 
    +    isLit (CmmLit {}) = True
    5939 
    +    isLit _           = False
    5940 
    +isSingleBit _ _ = Nothing
    5941 
    +
    5942 
    +bitTestOpWidthOK :: Bool -> Width -> Bool
    5943 
    +bitTestOpWidthOK is32Bit w = w == W32 || (w == W64 && not is32Bit)
    5944 
    +
    5945 
    +-- | Generate code for @dst := x@ followed by a bit-test instruction
    5946 
    +-- (btr/bts/btc) with bit offset @i@.  Analogous to 'genTrivialCode', but the
    5947 
    +-- offset operand must be a register, not memory.
    5948 
    +-- See Note [Bit-test instructions].
    5949 
    +genBitTestCode :: Format -> (Format -> Operand -> Operand -> Instr)
    5950 
    +               -> CmmExpr -> CmmExpr -> NatM Register
    5951 
    +genBitTestCode rep instr x i = do
    5952 
    +  (i_reg, i_code) <- getNonClobberedReg i
    5953 
    +  x_code <- getAnyReg x
    5954 
    +  tmp <- getNewRegNat rep
    5955 
    +  let
    5956 
    +     -- As in genTrivialCode, 'i' must stay alive across the computation of
    5957 
    +     -- 'x' into dst, so save it in a temporary if dst holds 'i'.
    5958 
    +     code dst
    5959 
    +        | dst == i_reg =
    5960 
    +                i_code `appOL`
    5961 
    +                unitOL (MOV rep (OpReg i_reg) (OpReg tmp)) `appOL`
    5962 
    +                x_code dst `snocOL`
    5963 
    +                instr rep (OpReg tmp) (OpReg dst)
    5964 
    +        | otherwise =
    5965 
    +                i_code `appOL`
    5966 
    +                x_code dst `snocOL`
    5967 
    +                instr rep (OpReg i_reg) (OpReg dst)
    5968 
    +  return (Any rep code)
    5969 
    +
    5886 5970 
     regClashesWithOp :: Reg -> Operand -> Bool
    5887 5971 
     reg `regClashesWithOp` OpReg reg2   = reg == reg2
    5888 5972 
     reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)

  • compiler/GHC/CmmToAsm/X86/Instr.hs
    ... ... @@ -193,6 +193,11 @@ data Instr
    193 193 
             | SHLD        Format Operand{-amount-} Operand Operand
    194 194
    195 195 
             | BT          Format Imm Operand
    196 
    +        -- Bit test-and-reset/set/complement; the bit offset must be an
    197 
    +        -- immediate or a register (not memory).
    198 
    +        | BTR         Format Operand{-bit offset-} Operand
    199 
    +        | BTS         Format Operand{-bit offset-} Operand
    200 
    +        | BTC         Format Operand{-bit offset-} Operand
    196 201 
             | NOP
    197 202
    198 203
    ... ... @@ -496,6 +501,9 @@ regUsageOfInstr platform instr
    496 501 
         SHLD   fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
    497 502 
         SHRD   fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
    498 503 
         BT     fmt _   src    -> mkRUR (use_R fmt src [])
    504 
    +    BTR    fmt off dst    -> usageRM fmt off dst
    505 
    +    BTS    fmt off dst    -> usageRM fmt off dst
    506 
    +    BTC    fmt off dst    -> usageRM fmt off dst
    499 507
    500 508 
         PUSH   fmt op         -> mkRUR (use_R fmt op [])
    501 509 
         POP    fmt op         -> mkRU [] (def_W fmt op)
    ... ... @@ -830,6 +838,9 @@ patchRegsOfInstr platform instr env
    830 838 
         SHLD fmt imm dst1 dst2 -> patch2 (SHLD fmt imm) dst1 dst2
    831 839 
         SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2
    832 840 
         BT   fmt imm src     -> patch1 (BT  fmt imm) src
    841 
    +    BTR  fmt off dst     -> patch2 (BTR fmt) off dst
    842 
    +    BTS  fmt off dst     -> patch2 (BTS fmt) off dst
    843 
    +    BTC  fmt off dst     -> patch2 (BTC fmt) off dst
    833 844 
         TEST fmt src dst     -> patch2 (TEST fmt) src dst
    834 845 
         CMP  fmt src dst     -> patch2 (CMP  fmt) src dst
    835 846 
         PUSH fmt op          -> patch1 (PUSH fmt) op

  • compiler/GHC/CmmToAsm/X86/Ppr.hs
    ... ... @@ -862,6 +862,15 @@ pprInstr platform i = case i of
    862 862 
        BT format imm src
    863 863 
           -> pprFormatImmOp (text "bt") format imm src
    864 864
    865 
    +   BTR format off dst
    866 
    +      -> pprFormatOpOp (text "btr") format off dst
    867 
    +
    868 
    +   BTS format off dst
    869 
    +      -> pprFormatOpOp (text "bts") format off dst
    870 
    +
    871 
    +   BTC format off dst
    872 
    +      -> pprFormatOpOp (text "btc") format off dst
    873 
    +
    865 874 
        CMP format src dst
    866 875 
          | isFloatFormat format -> pprFormatOpOp (text "ucomi") format src dst -- SSE2
    867 876 
          | otherwise            -> pprFormatOpOp (text "cmp")   format src dst

  • testsuite/tests/codeGen/should_gen_asm/T25233.asm
    1 
    +btrq
    2 
    +btsq
    3 
    +btcq

  • testsuite/tests/codeGen/should_gen_asm/T25233.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +
    3 
    +-- Check that clearing/setting/complementing a single, variable bit
    4 
    +-- uses the btr/bts/btc instructions (#25233).
    5 
    +module T25233 where
    6 
    +
    7 
    +import GHC.Exts
    8 
    +
    9 
    +myClearBit :: Word# -> Int# -> Word#
    10 
    +myClearBit x i = x `and#` not# (1## `uncheckedShiftL#` i)
    11 
    +
    12 
    +mySetBit :: Word# -> Int# -> Word#
    13 
    +mySetBit x i = x `or#` (1## `uncheckedShiftL#` i)
    14 
    +
    15 
    +myComplementBit :: Word# -> Int# -> Word#
    16 
    +myComplementBit x i = x `xor#` (1## `uncheckedShiftL#` i)

  • testsuite/tests/codeGen/should_gen_asm/all.T
    ... ... @@ -23,6 +23,8 @@ test('avx512-int64-minmax', [unless(arch('x86_64'), skip),
    23 23 
                                  when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl'])
    24 24 
     test('avx512-word64-minmax', [unless(arch('x86_64'), skip),
    25 25 
                                   when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl'])
    26 
    +test('T25233', [unless(arch('x86_64'), skip),
    27 
    +                when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-O'])
    26 28 
     is_aarch64_codegen = [
    27 29 
         unless(arch('aarch64'), skip),
    28 30 
         when(unregisterised(), skip),

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help