GitLab

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