Simon Jakobi pushed to branch wip/sjakobi/T27619-liveness-fixpoint-formats at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • compiler/GHC/CmmToAsm/Format.hs
    ... ... @@ -23,6 +23,7 @@ module GHC.CmmToAsm.Format (
    23 23 
         vecFormat,
    24 24 
         isVecFormat,
    25 25 
         cmmTypeFormat,
    26 
    +    compareFormat,
    26 27 
         formatToWidth,
    27 28 
         scalarWidth,
    28 29 
         formatInBytes,
    ... ... @@ -40,11 +41,13 @@ where
    40 41
    41 42 
     import GHC.Prelude
    42 43
    44 
    +import Data.Semigroup ( (<>) )
    45 
    +
    43 46 
     import GHC.Cmm
    44 47 
     import GHC.Platform.Reg ( Reg(..), RealReg, VirtualReg )
    45 48 
     import GHC.Types.Unique ( Uniquable(..) )
    46 49 
     import GHC.Types.Unique.Set
    47 
    -import GHC.Utils.Outputable
    50 
    +import GHC.Utils.Outputable hiding ( (<>) )
    48 51 
     import GHC.Utils.Panic
    49 52
    50 53 
     {- Note [GHC's data format representations]
    ... ... @@ -92,7 +95,9 @@ data Format
    92 95 
             | FF64
    93 96 
             | VecFormat !Length       -- ^ number of elements (always at least 2)
    94 97 
                         !ScalarFormat -- ^ format of each element
    95 
    -        deriving (Show, Eq, Ord)
    98 
    +        deriving (Show, Eq)
    99 
    +        -- No Ord: compare via 'formatToWidth', or use 'compareFormat' where a
    100 
    +        -- total order is needed.
    96 101
    97 102 
     pattern IntegerFormat :: Format
    98 103 
     pattern IntegerFormat <- ( isIntegerFormat -> True )
    ... ... @@ -117,7 +122,7 @@ data ScalarFormat
    117 122 
       | FmtInt64
    118 123 
       | FmtFloat
    119 124 
       | FmtDouble
    120 
    -  deriving (Show, Eq, Ord)
    125 
    +  deriving (Show, Eq)
    121 126
    122 127 
     scalarFormatFormat :: ScalarFormat -> Format
    123 128 
     scalarFormatFormat = \case
    ... ... @@ -248,6 +253,33 @@ scalarWidth = \case
    248 253 
     formatInBytes :: Format -> Int
    249 254 
     formatInBytes = widthInBytes . formatToWidth
    250 255
    256 
    +-- | Total order on formats: by width, with an arbitrary but fixed tiebreak
    257 
    +-- between distinct formats of the same width.
    258 
    +--
    259 
    +-- See Note [Convergence of the liveness fixpoint] in GHC.CmmToAsm.Reg.Liveness.
    260 
    +compareFormat :: Format -> Format -> Ordering
    261 
    +compareFormat f1 f2 =
    262 
    +    compare (formatToWidth f1) (formatToWidth f2) <> compare (tag f1) (tag f2)
    263 
    +  where
    264 
    +    tag :: Format -> (Int, Length)
    265 
    +    tag = \case
    266 
    +      II8           -> (0, 0)
    267 
    +      II16          -> (1, 0)
    268 
    +      II32          -> (2, 0)
    269 
    +      II64          -> (3, 0)
    270 
    +      FF32          -> (4, 0)
    271 
    +      FF64          -> (5, 0)
    272 
    +      VecFormat l s -> (6 + scalarTag s, l)
    273 
    +
    274 
    +    scalarTag :: ScalarFormat -> Int
    275 
    +    scalarTag = \case
    276 
    +      FmtInt8   -> 0
    277 
    +      FmtInt16  -> 1
    278 
    +      FmtInt32  -> 2
    279 
    +      FmtInt64  -> 3
    280 
    +      FmtFloat  -> 4
    281 
    +      FmtDouble -> 5
    282 
    +
    251 283 
     --------------------------------------------------------------------------------
    252 284
    253 285 
     -- | A typed virtual register: a virtual register, together with the specific

  • compiler/GHC/CmmToAsm/PPC/CodeGen.hs
    ... ... @@ -484,7 +484,7 @@ getRegister' _ _ (CmmMachOp (MO_SS_Conv src tgt) [CmmLoad mem pk _])
    484 484 
       , src < tgt = do
    485 485 
           let format = cmmTypeFormat pk
    486 486 
           -- lwa is DS-form. See Note [Power instruction format]
    487 
    -      let form = if format >= II32 then DS else D
    487 
    +      let form = if formatToWidth format >= W32 then DS else D
    488 488 
           Amode addr addr_code <- getAmode form mem
    489 489 
           let code dst = assert (format == intFormat src)
    490 490 
                          $ addr_code `snocOL` LA format dst addr

  • compiler/GHC/CmmToAsm/Reg/Liveness.hs
    ... ... @@ -879,7 +879,7 @@ computeLiveness platform sccs
    879 879 
                                             , ppr sccs'])
    880 880
    881 881 
     livenessSCCs
    882 
    -       :: Instruction instr
    882 
    +       :: forall instr. Instruction instr
    883 883 
            => Platform
    884 884 
            -> BlockMap Regs
    885 885 
            -> [SCC (LiveBasicBlock instr)]          -- accum
    ... ... @@ -897,37 +897,50 @@ livenessSCCs platform blockmap done (AcyclicSCC block : sccs)
    897 897 
     livenessSCCs platform blockmap done
    898 898 
             (CyclicSCC blocks : sccs) =
    899 899 
             livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs
    900 
    - where      (blockmap', blocks')
    901 
    -                = iterateUntilUnchanged linearLiveness equalBlockMaps
    902 
    -                                      blockmap blocks
    900 
    + where      (blockmap', blocks') = fixpoint blockmap
    903 901
    904 
    -            iterateUntilUnchanged
    905 
    -                :: (a -> b -> (a,c)) -> (a -> a -> Bool)
    906 
    -                -> a -> b
    907 
    -                -> (a,c)
    908 
    -
    909 
    -            iterateUntilUnchanged f eq aa b = go aa
    902 
    +            -- See Note [Convergence of the liveness fixpoint]
    903 
    +            fixpoint :: BlockMap Regs -> (BlockMap Regs, [LiveBasicBlock instr])
    904 
    +            fixpoint bm
    905 
    +                | all unchanged blocks = (bm', blocks'')
    906 
    +                | otherwise            = fixpoint bm'
    910 907 
                   where
    911 
    -                go a = if eq a a' then ac else go a'
    912 
    -                  where
    913 
    -                    ac@(a', _) = f a b
    914 
    -
    915 
    -            linearLiveness
    916 
    -                :: Instruction instr
    917 
    -                => BlockMap Regs -> [LiveBasicBlock instr]
    918 
    -                -> (BlockMap Regs, [LiveBasicBlock instr])
    919 
    -
    920 
    -            linearLiveness = mapAccumL (livenessBlock platform)
    921 
    -
    922 
    -                -- probably the least efficient way to compare two
    923 
    -                -- BlockMaps for equality.
    924 
    -            equalBlockMaps :: BlockMap Regs -> BlockMap Regs -> Bool
    925 
    -            equalBlockMaps a b
    926 
    -                = a' == b'
    927 
    -              where a' = mapToList a
    928 
    -                    b' = mapToList b
    929 
    -                    -- See Note [Unique Determinism and code generation]
    930 
    -
    908 
    +                (bm', blocks'') = mapAccumL (livenessBlock platform) bm blocks
    909 
    +
    910 
    +                unchanged :: LiveBasicBlock instr -> Bool
    911 
    +                unchanged block =
    912 
    +                    case (mapLookup bid bm, mapLookup bid bm') of
    913 
    +                        (Just old, Just new) -> old `equalRegs` new
    914 
    +                        (Nothing,  _       ) -> False  -- first iteration
    915 
    +                        (Just _,   Nothing ) -> False  -- can't happen
    916 
    +                  where bid = blockId block
    917 
    +
    918 
    +{- Note [Convergence of the liveness fixpoint]
    919 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    920 
    +For a cyclic SCC, we iterate 'livenessBlock' over the SCC's blocks until the
    921 
    +recorded entry liveness stops changing. Two subtleties in the convergence
    922 
    +test:
    923 
    +
    924 
    +* It must compare register formats, not just sets of live registers –
    925 
    +  hence the format-aware 'equalRegs'. A block's live-in set joins the
    926 
    +  successors' entries with 'unionRegsMaxFmt', so a wide format may take one
    927 
    +  iteration per control-flow edge to propagate backwards around a loop. The
    928 
    +  register sets themselves are typically complete after the first iteration.
    929 
    +  If we stopped as soon as the sets stabilise, a register could be recorded
    930 
    +  at a narrower format than the reads it flows into. That would violate
    931 
    +  property (FmtBwd1) of Note [Register formats in liveness analysis], which
    932 
    +  the register allocator relies on for spill and reload widths. See #27619.
    933 
    +
    934 
    +* It is sufficient to compare the entries of the SCC's own blocks. No other
    935 
    +  entries can change: 'livenessBlock' inserts only the block it processes,
    936 
    +  and successor SCCs are already final because SCCs are processed in reverse
    937 
    +  dependency order. Comparing the whole accumulated block map would make the
    938 
    +  fixpoint quadratic in procedure size (#27437).
    939 
    +
    940 
    +To ensure termination, 'maxRegWithFormat' uses 'compareFormat' which defines a
    941 
    +total order on formats. Comparing the widths only would introduce the risk of
    942 
    +an infinite loop where each iteration swaps two formats of the same width.
    943 
    +-}
    931 944
    932 945
    933 946 
     -- | Annotate a basic block with register liveness information.

  • compiler/GHC/CmmToAsm/Reg/Regs.hs
    ... ... @@ -13,16 +13,19 @@ module GHC.CmmToAsm.Reg.Regs (
    13 13 
             shrinkingRegs,
    14 14 
             mapRegs,
    15 15 
             elemRegs, lookupReg,
    16 
    +        equalRegs,
    16 17
    17 18 
       ) where
    18 19
    19 20 
     import GHC.Prelude
    20 21
    21 22 
     import GHC.Platform.Reg     ( Reg )
    22 
    -import GHC.CmmToAsm.Format  ( Format, RegWithFormat(..), isVecFormat )
    23 
    +import GHC.CmmToAsm.Format  ( Format, RegWithFormat(..), isVecFormat,
    24 
    +                              compareFormat, formatToWidth )
    23 25
    24 26 
     import GHC.Utils.Outputable ( Outputable )
    25 27 
     import GHC.Types.Unique     ( Uniquable(..) )
    28 
    +import GHC.Types.Unique.FM  ( equalUFMBy )
    26 29 
     import GHC.Types.Unique.Set
    27 30
    28 31 
     import Data.Coerce ( coerce )
    ... ... @@ -33,15 +36,16 @@ import Data.Coerce ( coerce )
    33 36 
     -- register liveness analysis.  See Note [Register formats in liveness analysis]
    34 37 
     -- in GHC.CmmToAsm.Reg.Liveness.
    35 38 
     newtype Regs = Regs { getRegs :: UniqSet RegWithFormat }
    36 
    -  deriving newtype (Eq, Outputable)
    39 
    +  deriving newtype (Outputable)
    37 40
    38 41 
     maxRegWithFormat :: RegWithFormat -> RegWithFormat -> RegWithFormat
    39 42 
     maxRegWithFormat r1@(RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2)
    40 
    -  = if fmt1 >= fmt2
    41 
    -    then r1
    42 
    -    else r2
    43 
    -  -- Re-using one of the arguments avoids allocating a new 'RegWithFormat',
    44 
    -  -- compared with returning 'RegWithFormat r1 (max fmt1 fmt2)'.
    43 
    +  | LT <- compareFormat fmt1 fmt2 = r2
    44 
    +  | otherwise                     = r1
    45 
    +  -- See Note [Convergence of the liveness fixpoint] in
    46 
    +  -- GHC.CmmToAsm.Reg.Liveness.
    47 
    +  --
    48 
    +  -- Re-using one of the arguments avoids allocating a new 'RegWithFormat'.
    45 49
    46 50 
     noRegs :: Regs
    47 51 
     noRegs = Regs emptyUniqSet
    ... ... @@ -64,7 +68,7 @@ minusCoveredRegs = coerce $ minusUniqSet_C f
    64 68 
       where
    65 69 
         f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat
    66 70 
         f r1@(RegWithFormat _ fmt1) (RegWithFormat _ fmt2) =
    67 
    -      if fmt2 >= fmt1
    71 
    +      if formatToWidth fmt2 >= formatToWidth fmt1
    68 72 
                ||
    69 73 
              not ( isVecFormat fmt1 )
    70 74 
               -- See Wrinkle [Don't allow scalar partial writes]
    ... ... @@ -97,7 +101,7 @@ shrinkingRegs = coerce $ minusUniqSet_C f
    97 101 
       where
    98 102 
         f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat
    99 103 
         f (RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2)
    100 
    -      | fmt2 < fmt1
    104 
    +      | formatToWidth fmt2 < formatToWidth fmt1
    101 105 
           = Just r2
    102 106 
           | otherwise
    103 107 
           = Nothing
    ... ... @@ -117,3 +121,10 @@ elemRegs r (Regs live) = elemUniqSet_Directly (getUnique r) live
    117 121 
     lookupReg :: Reg -> Regs -> Maybe Format
    118 122 
     lookupReg r (Regs live) =
    119 123 
       regWithFormat_format <$> lookupUniqSet_Directly live (getUnique r)
    124 
    +
    125 
    +-- | Do the two sets contain the same registers, at the same formats?
    126 
    +equalRegs :: Regs -> Regs -> Bool
    127 
    +equalRegs (Regs a) (Regs b) = equalUFMBy sameFormat (getUniqSet a) (getUniqSet b)
    128 
    +  where
    129 
    +    -- Registers with equal uniques are equal, so only compare the formats.
    130 
    +    sameFormat (RegWithFormat _ fmt1) (RegWithFormat _ fmt2) = fmt1 == fmt2

  • compiler/GHC/Types/Unique/FM.hs
    ... ... @@ -67,6 +67,7 @@ module GHC.Types.Unique.FM (
    67 67 
             strictIntersectUFM_C,
    68 68 
             disjointUFM,
    69 69 
             equalKeysUFM,
    70 
    +        equalUFMBy,
    70 71 
             diffUFM,
    71 72 
             nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM,
    72 73 
             nonDetFoldWithKeyUFM,
    ... ... @@ -590,7 +591,12 @@ unsafeCastUFMKey (UFM m) = UFM m
    590 591
    591 592 
     -- Determines whether two 'UniqFM's contain the same keys.
    592 593 
     equalKeysUFM :: UniqFM key a -> UniqFM key b -> Bool
    593 
    -equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
    594 
    +equalKeysUFM = equalUFMBy (\_ _ -> True)
    595 
    +
    596 
    +-- | Determines whether two 'UniqFM's contain the same keys, with values
    597 
    +-- that agree according to the given predicate.
    598 
    +equalUFMBy :: (a -> b -> Bool) -> UniqFM key a -> UniqFM key b -> Bool
    599 
    +equalUFMBy eq (UFM m1) (UFM m2) = liftEq eq m1 m2
    594 600
    595 601 
     -- | An edit on type @a@, relating an element of a container (like an entry in a
    596 602 
     -- map or a line in a file) before and after.

  • testsuite/tests/regalloc/T27619.hs
    1 
    +{-# LANGUAGE MagicHash, UnboxedTuples #-}
    2 
    +
    3 
    +-- The native code for this loop is a three-block cycle H -> X -> W -> H:
    4 
    +--
    5 
    +--   H, X: read v at FF64   (lane-0 extracts)
    6 
    +--   W:    reads v at F64x2 (the full unpack)
    7 
    +--
    8 
    +-- v is loop-invariant, so its live format on entry to every block in the
    9 
    +-- cycle must be F64x2. -fno-cse keeps the two syntactically identical
    10 
    +-- lane-0 extracts from being merged.
    11 
    +module T27619 where
    12 
    +
    13 
    +import GHC.Exts
    14 
    +
    15 
    +loop :: Int# -> DoubleX2# -> Double# -> Double#
    16 
    +loop i v acc =
    17 
    +  case unpackDoubleX2# v of
    18 
    +    (# a1, _ #) ->
    19 
    +      if isTrue# (a1 <## int2Double# i)
    20 
    +      then acc
    21 
    +      else case unpackDoubleX2# v of
    22 
    +        (# a2, _ #) ->
    23 
    +          if isTrue# (a2 *## 2.0## <## int2Double# i)
    24 
    +          then acc *## 2.0##
    25 
    +          else case unpackDoubleX2# v of
    26 
    +            (# x, y #) -> loop (i -# 1#) v (acc +## (x *## y))
    27 
    +{-# NOINLINE loop #-}

  • testsuite/tests/regalloc/all.T
    ... ... @@ -6,3 +6,14 @@ test('regalloc_unit_tests',
    6 6 
            [ignore_stderr, only_ways(['normal'])], extra_run_opts('"' + config.libdir + '"') ],
    7 7 
          compile_and_run,
    8 8 
          ['-package ghc'])
    9 
    +
    10 
    +# The liveness fixpoint must iterate until the register formats converge, not
    11 
    +# just the sets of live registers (#27619). A vector register live at
    12 
    +# VecFormat 2 FmtDouble around the loop must not be recorded at FF64.
    13 
    +test('T27619',
    14 
    +     [ unless(arch('x86_64'), skip),
    15 
    +       when(not have_ncg(), skip),
    16 
    +       only_ways(['normal']),
    17 
    +       grep_errmsg(r'%vV128_\S+ :: FF64') ],
    18 
    +     compile,
    19 
    +     ['-O -fno-cse -ddump-asm-liveness'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/10e6330d9c54a295946b9aebb05a6df59d8de13e...8d5058d9494df497da7badabaa0d6003fb8b6bf4 at 1786957640