Simon Jakobi pushed to branch wip/sjakobi/T27619-liveness-fixpoint-formats at Glasgow Haskell Compiler / GHC Commits: 103d8ba4 by Simon Jakobi at 2026-08-17T11:02:25+02:00 NCG: iterate the liveness fixpoint until register formats converge The convergence test of the per-SCC liveness fixpoint in GHC.CmmToAsm.Reg.Liveness compared BlockMap Regs values with the key-only Eq of UniqSet, which ignores the Format attached to each register. Formats grow across iterations (one control-flow edge per iteration), so the fixpoint could stop while formats were still growing, recording a vector register live at a too-narrow format and handing the register allocator an under-sized spill/reload width (#27619). The test also compared the entire accumulated block map on every iteration, although only the current SCC's entries can change, making it quadratic in procedure size (#27437). Compare only the SCC's own entries, using the new format-aware equalRegs. See the new Note [Convergence of the liveness fixpoint]. Also remove the Eq instance of Regs: inherited from UniqSet, it compared the register uniques only, silently ignoring the formats. The convergence test was its sole user. Fixes #27619. Fixes #27437. Assisted-by: Claude Fable 5 - - - - - 8d5058d9 by Simon Jakobi at 2026-08-17T11:02:25+02:00 NCG: compare register formats by width, remove Ord Format maxRegWithFormat, minusCoveredRegs and shrinkingRegs compared formats with Format's derived Ord, which orders by constructor, not by width: FF32 > II64, and VecFormat 16 FmtInt8 (16 bytes) > VecFormat 8 FmtDouble (64 bytes). This is harmless while all vector vregs are 128-bit, but becomes unsound in the (FmtBwd2) direction of Note [Register formats in liveness analysis] once wider vectors land in the NCG. Noted in #27619. The comparisons now go by formatToWidth, except the liveness join maxRegWithFormat, which needs a total order to keep the liveness fixpoint convergent and uses the new width-major compareFormat. See Note [Convergence of the liveness fixpoint] in GHC.CmmToAsm.Reg.Liveness. Also remove the Ord instances of Format and ScalarFormat, so no future call site can mistake the derived order for a width order. Their only other user was a width test in GHC.CmmToAsm.PPC.CodeGen, now expressed with formatToWidth. Assisted-by: Claude Fable 5 - - - - - 7 changed files: - compiler/GHC/CmmToAsm/Format.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/Reg/Regs.hs - compiler/GHC/Types/Unique/FM.hs - + testsuite/tests/regalloc/T27619.hs - testsuite/tests/regalloc/all.T Changes: ===================================== compiler/GHC/CmmToAsm/Format.hs ===================================== @@ -23,6 +23,7 @@ module GHC.CmmToAsm.Format ( vecFormat, isVecFormat, cmmTypeFormat, + compareFormat, formatToWidth, scalarWidth, formatInBytes, @@ -40,11 +41,13 @@ where import GHC.Prelude +import Data.Semigroup ( (<>) ) + import GHC.Cmm import GHC.Platform.Reg ( Reg(..), RealReg, VirtualReg ) import GHC.Types.Unique ( Uniquable(..) ) import GHC.Types.Unique.Set -import GHC.Utils.Outputable +import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic {- Note [GHC's data format representations] @@ -92,7 +95,9 @@ data Format | FF64 | VecFormat !Length -- ^ number of elements (always at least 2) !ScalarFormat -- ^ format of each element - deriving (Show, Eq, Ord) + deriving (Show, Eq) + -- No Ord: compare via 'formatToWidth', or use 'compareFormat' where a + -- total order is needed. pattern IntegerFormat :: Format pattern IntegerFormat <- ( isIntegerFormat -> True ) @@ -117,7 +122,7 @@ data ScalarFormat | FmtInt64 | FmtFloat | FmtDouble - deriving (Show, Eq, Ord) + deriving (Show, Eq) scalarFormatFormat :: ScalarFormat -> Format scalarFormatFormat = \case @@ -248,6 +253,33 @@ scalarWidth = \case formatInBytes :: Format -> Int formatInBytes = widthInBytes . formatToWidth +-- | Total order on formats: by width, with an arbitrary but fixed tiebreak +-- between distinct formats of the same width. +-- +-- See Note [Convergence of the liveness fixpoint] in GHC.CmmToAsm.Reg.Liveness. +compareFormat :: Format -> Format -> Ordering +compareFormat f1 f2 = + compare (formatToWidth f1) (formatToWidth f2) <> compare (tag f1) (tag f2) + where + tag :: Format -> (Int, Length) + tag = \case + II8 -> (0, 0) + II16 -> (1, 0) + II32 -> (2, 0) + II64 -> (3, 0) + FF32 -> (4, 0) + FF64 -> (5, 0) + VecFormat l s -> (6 + scalarTag s, l) + + scalarTag :: ScalarFormat -> Int + scalarTag = \case + FmtInt8 -> 0 + FmtInt16 -> 1 + FmtInt32 -> 2 + FmtInt64 -> 3 + FmtFloat -> 4 + FmtDouble -> 5 + -------------------------------------------------------------------------------- -- | 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 _]) , src < tgt = do let format = cmmTypeFormat pk -- lwa is DS-form. See Note [Power instruction format] - let form = if format >= II32 then DS else D + let form = if formatToWidth format >= W32 then DS else D Amode addr addr_code <- getAmode form mem let code dst = assert (format == intFormat src) $ addr_code `snocOL` LA format dst addr ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -879,7 +879,7 @@ computeLiveness platform sccs , ppr sccs']) livenessSCCs - :: Instruction instr + :: forall instr. Instruction instr => Platform -> BlockMap Regs -> [SCC (LiveBasicBlock instr)] -- accum @@ -897,37 +897,50 @@ livenessSCCs platform blockmap done (AcyclicSCC block : sccs) livenessSCCs platform blockmap done (CyclicSCC blocks : sccs) = livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs - where (blockmap', blocks') - = iterateUntilUnchanged linearLiveness equalBlockMaps - blockmap blocks + where (blockmap', blocks') = fixpoint blockmap - iterateUntilUnchanged - :: (a -> b -> (a,c)) -> (a -> a -> Bool) - -> a -> b - -> (a,c) - - iterateUntilUnchanged f eq aa b = go aa + -- See Note [Convergence of the liveness fixpoint] + fixpoint :: BlockMap Regs -> (BlockMap Regs, [LiveBasicBlock instr]) + fixpoint bm + | all unchanged blocks = (bm', blocks'') + | otherwise = fixpoint bm' where - go a = if eq a a' then ac else go a' - where - ac@(a', _) = f a b - - linearLiveness - :: Instruction instr - => BlockMap Regs -> [LiveBasicBlock instr] - -> (BlockMap Regs, [LiveBasicBlock instr]) - - linearLiveness = mapAccumL (livenessBlock platform) - - -- probably the least efficient way to compare two - -- BlockMaps for equality. - equalBlockMaps :: BlockMap Regs -> BlockMap Regs -> Bool - equalBlockMaps a b - = a' == b' - where a' = mapToList a - b' = mapToList b - -- See Note [Unique Determinism and code generation] - + (bm', blocks'') = mapAccumL (livenessBlock platform) bm blocks + + unchanged :: LiveBasicBlock instr -> Bool + unchanged block = + case (mapLookup bid bm, mapLookup bid bm') of + (Just old, Just new) -> old `equalRegs` new + (Nothing, _ ) -> False -- first iteration + (Just _, Nothing ) -> False -- can't happen + where bid = blockId block + +{- Note [Convergence of the liveness fixpoint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a cyclic SCC, we iterate 'livenessBlock' over the SCC's blocks until the +recorded entry liveness stops changing. Two subtleties in the convergence +test: + +* It must compare register formats, not just sets of live registers – + hence the format-aware 'equalRegs'. A block's live-in set joins the + successors' entries with 'unionRegsMaxFmt', so a wide format may take one + iteration per control-flow edge to propagate backwards around a loop. The + register sets themselves are typically complete after the first iteration. + If we stopped as soon as the sets stabilise, a register could be recorded + at a narrower format than the reads it flows into. That would violate + property (FmtBwd1) of Note [Register formats in liveness analysis], which + the register allocator relies on for spill and reload widths. See #27619. + +* It is sufficient to compare the entries of the SCC's own blocks. No other + entries can change: 'livenessBlock' inserts only the block it processes, + and successor SCCs are already final because SCCs are processed in reverse + dependency order. Comparing the whole accumulated block map would make the + fixpoint quadratic in procedure size (#27437). + +To ensure termination, 'maxRegWithFormat' uses 'compareFormat' which defines a +total order on formats. Comparing the widths only would introduce the risk of +an infinite loop where each iteration swaps two formats of the same width. +-} -- | Annotate a basic block with register liveness information. ===================================== compiler/GHC/CmmToAsm/Reg/Regs.hs ===================================== @@ -13,16 +13,19 @@ module GHC.CmmToAsm.Reg.Regs ( shrinkingRegs, mapRegs, elemRegs, lookupReg, + equalRegs, ) where import GHC.Prelude import GHC.Platform.Reg ( Reg ) -import GHC.CmmToAsm.Format ( Format, RegWithFormat(..), isVecFormat ) +import GHC.CmmToAsm.Format ( Format, RegWithFormat(..), isVecFormat, + compareFormat, formatToWidth ) import GHC.Utils.Outputable ( Outputable ) import GHC.Types.Unique ( Uniquable(..) ) +import GHC.Types.Unique.FM ( equalUFMBy ) import GHC.Types.Unique.Set import Data.Coerce ( coerce ) @@ -33,15 +36,16 @@ import Data.Coerce ( coerce ) -- register liveness analysis. See Note [Register formats in liveness analysis] -- in GHC.CmmToAsm.Reg.Liveness. newtype Regs = Regs { getRegs :: UniqSet RegWithFormat } - deriving newtype (Eq, Outputable) + deriving newtype (Outputable) maxRegWithFormat :: RegWithFormat -> RegWithFormat -> RegWithFormat maxRegWithFormat r1@(RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2) - = if fmt1 >= fmt2 - then r1 - else r2 - -- Re-using one of the arguments avoids allocating a new 'RegWithFormat', - -- compared with returning 'RegWithFormat r1 (max fmt1 fmt2)'. + | LT <- compareFormat fmt1 fmt2 = r2 + | otherwise = r1 + -- See Note [Convergence of the liveness fixpoint] in + -- GHC.CmmToAsm.Reg.Liveness. + -- + -- Re-using one of the arguments avoids allocating a new 'RegWithFormat'. noRegs :: Regs noRegs = Regs emptyUniqSet @@ -64,7 +68,7 @@ minusCoveredRegs = coerce $ minusUniqSet_C f where f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat f r1@(RegWithFormat _ fmt1) (RegWithFormat _ fmt2) = - if fmt2 >= fmt1 + if formatToWidth fmt2 >= formatToWidth fmt1 || not ( isVecFormat fmt1 ) -- See Wrinkle [Don't allow scalar partial writes] @@ -97,7 +101,7 @@ shrinkingRegs = coerce $ minusUniqSet_C f where f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat f (RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2) - | fmt2 < fmt1 + | formatToWidth fmt2 < formatToWidth fmt1 = Just r2 | otherwise = Nothing @@ -117,3 +121,10 @@ elemRegs r (Regs live) = elemUniqSet_Directly (getUnique r) live lookupReg :: Reg -> Regs -> Maybe Format lookupReg r (Regs live) = regWithFormat_format <$> lookupUniqSet_Directly live (getUnique r) + +-- | Do the two sets contain the same registers, at the same formats? +equalRegs :: Regs -> Regs -> Bool +equalRegs (Regs a) (Regs b) = equalUFMBy sameFormat (getUniqSet a) (getUniqSet b) + where + -- Registers with equal uniques are equal, so only compare the formats. + sameFormat (RegWithFormat _ fmt1) (RegWithFormat _ fmt2) = fmt1 == fmt2 ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -67,6 +67,7 @@ module GHC.Types.Unique.FM ( strictIntersectUFM_C, disjointUFM, equalKeysUFM, + equalUFMBy, diffUFM, nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM, nonDetFoldWithKeyUFM, @@ -590,7 +591,12 @@ unsafeCastUFMKey (UFM m) = UFM m -- Determines whether two 'UniqFM's contain the same keys. equalKeysUFM :: UniqFM key a -> UniqFM key b -> Bool -equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2 +equalKeysUFM = equalUFMBy (\_ _ -> True) + +-- | Determines whether two 'UniqFM's contain the same keys, with values +-- that agree according to the given predicate. +equalUFMBy :: (a -> b -> Bool) -> UniqFM key a -> UniqFM key b -> Bool +equalUFMBy eq (UFM m1) (UFM m2) = liftEq eq m1 m2 -- | An edit on type @a@, relating an element of a container (like an entry in a -- map or a line in a file) before and after. ===================================== testsuite/tests/regalloc/T27619.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- The native code for this loop is a three-block cycle H -> X -> W -> H: +-- +-- H, X: read v at FF64 (lane-0 extracts) +-- W: reads v at F64x2 (the full unpack) +-- +-- v is loop-invariant, so its live format on entry to every block in the +-- cycle must be F64x2. -fno-cse keeps the two syntactically identical +-- lane-0 extracts from being merged. +module T27619 where + +import GHC.Exts + +loop :: Int# -> DoubleX2# -> Double# -> Double# +loop i v acc = + case unpackDoubleX2# v of + (# a1, _ #) -> + if isTrue# (a1 <## int2Double# i) + then acc + else case unpackDoubleX2# v of + (# a2, _ #) -> + if isTrue# (a2 *## 2.0## <## int2Double# i) + then acc *## 2.0## + else case unpackDoubleX2# v of + (# x, y #) -> loop (i -# 1#) v (acc +## (x *## y)) +{-# NOINLINE loop #-} ===================================== testsuite/tests/regalloc/all.T ===================================== @@ -6,3 +6,14 @@ test('regalloc_unit_tests', [ignore_stderr, only_ways(['normal'])], extra_run_opts('"' + config.libdir + '"') ], compile_and_run, ['-package ghc']) + +# The liveness fixpoint must iterate until the register formats converge, not +# just the sets of live registers (#27619). A vector register live at +# VecFormat 2 FmtDouble around the loop must not be recorded at FF64. +test('T27619', + [ unless(arch('x86_64'), skip), + when(not have_ncg(), skip), + only_ways(['normal']), + grep_errmsg(r'%vV128_\S+ :: FF64') ], + compile, + ['-O -fno-cse -ddump-asm-liveness']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10e6330d9c54a295946b9aebb05a6df... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10e6330d9c54a295946b9aebb05a6df... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help