Simon Jakobi pushed to branch wip/sjakobi/T27619-liveness-fixpoint-formats at Glasgow Haskell Compiler / GHC Commits: 1ad7425a by Simon Jakobi at 2026-08-17T23:12:15+02:00 NCG: compare register formats by width, remove Ord Format maxRegWithFormat, minusCoveredRegs and the caller-less shrinkingRegs compared formats with Format's derived Ord, which ordered by constructor, not by width: For example, VecFormat 16 FmtInt8 (16 bytes) sorted above a hypothetical VecFormat 8 FmtDouble (64 bytes). This is harmless while all vector vregs are 128-bit, but once wider vectors land in the NCG it becomes unsound in both directions of Note [Register formats in liveness analysis]: the maxRegWithFormat join could record a live format narrower than a read, violating (FmtBwd1), and minusCoveredRegs could treat a narrow vector write as covering a wider live format, violating (FmtBwd2). 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. Apart from future-proofing for larger vector formats, these changes also make the code more obviously correct today. Also remove the Ord instances of Format and ScalarFormat, so future users need to make a conscious choice between formatToWidth and compareFormat. Assisted-by: Claude Fable 5 - - - - - 4 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 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 ===================================== @@ -937,9 +937,9 @@ test: dependency order. Comparing the whole accumulated block map would make the fixpoint quadratic in procedure size (#27437). -The fixpoint terminates because the entries can only grow: registers are -only added, formats only increase via 'maxRegWithFormat' joins, and both -lattices are finite. +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. -} ===================================== compiler/GHC/CmmToAsm/Reg/Regs.hs ===================================== @@ -20,7 +20,8 @@ module GHC.CmmToAsm.Reg.Regs ( 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(..) ) @@ -39,11 +40,12 @@ newtype Regs = Regs { getRegs :: UniqSet RegWithFormat } 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 @@ -66,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] @@ -99,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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ad7425a61af41a5e26fa79b3ba9e1cc... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ad7425a61af41a5e26fa79b3ba9e1cc... 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