    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE LambdaCase #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -----------------------------------------------------------------------------
    --
    -- Cmm utilities.
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    module GHC.Cmm.Utils(
            -- CmmType
            primRepCmmType, slotCmmType,
            typeCmmType, typeForeignHint, primRepForeignHint,

            -- CmmLit
            zeroCLit, mkIntCLit,
            mkWordCLit, packHalfWordsCLit,
            mkByteStringCLit, mkFileEmbedLit,
            mkDataLits, mkRODataLits,
            mkStgWordCLit,

            -- CmmExpr
            mkIntExpr, zeroExpr,
            mkLblExpr,
            cmmRegOff,  cmmOffset,  cmmLabelOff,  cmmOffsetLit,  cmmOffsetExpr,
            cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,
            cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,
            cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,
            cmmLoadBWord, cmmLoadGCWord,
            cmmNegate,
            cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,
            cmmSLtWord,
            cmmNeWord, cmmEqWord,
            cmmOrWord, cmmAndWord,
            cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord,
            cmmToWord,

            cmmMkAssign,

            baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,
            currentTSOExpr, currentNurseryExpr, cccsExpr,

            -- Tagging
            cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged, cmmIsNotTagged,
            cmmConstrTag1, mAX_PTR_TAG, tAG_MASK,

            -- Overlap and usage
            regsOverlap, globalRegsOverlap, regUsedIn, globalRegUsedIn,

            -- Liveness and bitmaps
            mkLiveness,

            -- * Operations that probably don't belong here
            modifyGraph,

            ofBlockMap, toBlockMap,
            ofBlockList, toBlockList,
            toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,
            foldlGraphBlocks, mapGraphNodes, mapGraphNodes1,

            -- * Ticks
            blockTicks
      ) where

    import GHC.Prelude

    import GHC.Core.TyCon     ( PrimRep(..), PrimElemRep(..) )
    import GHC.Types.RepType  ( NvUnaryType, SlotTy (..), typePrimRepU )

    import GHC.Platform
    import GHC.Runtime.Heap.Layout
    import GHC.Cmm
    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.Unique
    import GHC.Platform.Regs

    import Data.ByteString (ByteString)
    import qualified Data.ByteString as BS
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.Dataflow.Block

    ---------------------------------------------------
    --
    --      CmmTypes
    --
    ---------------------------------------------------

    primRepCmmType :: Platform -> PrimRep -> CmmType
    primRepCmmType :: Platform -> PrimRep -> CmmType
    primRepCmmType Platform
    platform = \case
       BoxedRep Maybe Levity
    _       -> Platform -> CmmType
    gcWord Platform
    platform
       PrimRep
    IntRep           -> Platform -> CmmType
    bWord Platform
    platform
       PrimRep
    WordRep          -> Platform -> CmmType
    bWord Platform
    platform
       PrimRep
    Int8Rep          -> CmmType
    b8
       PrimRep
    Word8Rep         -> CmmType
    b8
       PrimRep
    Int16Rep         -> CmmType
    b16
       PrimRep
    Word16Rep        -> CmmType
    b16
       PrimRep
    Int32Rep         -> CmmType
    b32
       PrimRep
    Word32Rep        -> CmmType
    b32
       PrimRep
    Int64Rep         -> CmmType
    b64
       PrimRep
    Word64Rep        -> CmmType
    b64
       PrimRep
    AddrRep          -> Platform -> CmmType
    bWord Platform
    platform
       PrimRep
    FloatRep         -> CmmType
    f32
       PrimRep
    DoubleRep        -> CmmType
    f64
       VecRep Int
    len PrimElemRep
    rep   -> Int -> CmmType -> CmmType
    vec Int
    len (PrimElemRep -> CmmType
    primElemRepCmmType PrimElemRep
    rep)

    slotCmmType :: Platform -> SlotTy -> CmmType
    slotCmmType :: Platform -> SlotTy -> CmmType
    slotCmmType Platform
    platform = \case
       SlotTy
    PtrUnliftedSlot -> Platform -> CmmType
    gcWord Platform
    platform
       SlotTy
    PtrLiftedSlot   -> Platform -> CmmType
    gcWord Platform
    platform
       SlotTy
    WordSlot        -> Platform -> CmmType
    bWord Platform
    platform
       SlotTy
    Word64Slot      -> CmmType
    b64
       SlotTy
    FloatSlot       -> CmmType
    f32
       SlotTy
    DoubleSlot      -> CmmType
    f64
       VecSlot Int
    l PrimElemRep
    e     -> Int -> CmmType -> CmmType
    vec Int
    l (PrimElemRep -> CmmType
    primElemRepCmmType PrimElemRep
    e)

    primElemRepCmmType :: PrimElemRep -> CmmType
    primElemRepCmmType :: PrimElemRep -> CmmType
    primElemRepCmmType PrimElemRep
    Int8ElemRep   = CmmType
    b8
    primElemRepCmmType PrimElemRep
    Int16ElemRep  = CmmType
    b16
    primElemRepCmmType PrimElemRep
    Int32ElemRep  = CmmType
    b32
    primElemRepCmmType PrimElemRep
    Int64ElemRep  = CmmType
    b64
    primElemRepCmmType PrimElemRep
    Word8ElemRep  = CmmType
    b8
    primElemRepCmmType PrimElemRep
    Word16ElemRep = CmmType
    b16
    primElemRepCmmType PrimElemRep
    Word32ElemRep = CmmType
    b32
    primElemRepCmmType PrimElemRep
    Word64ElemRep = CmmType
    b64
    primElemRepCmmType PrimElemRep
    FloatElemRep  = CmmType
    f32
    primElemRepCmmType PrimElemRep
    DoubleElemRep = CmmType
    f64

    typeCmmType :: Platform -> NvUnaryType -> CmmType
    typeCmmType :: Platform -> NvUnaryType -> CmmType
    typeCmmType Platform
    platform NvUnaryType
    ty = Platform -> PrimRep -> CmmType
    primRepCmmType Platform
    platform (HasDebugCallStack => NvUnaryType -> PrimRep
    NvUnaryType -> PrimRep
    typePrimRepU NvUnaryType
    ty)

    primRepForeignHint :: PrimRep -> ForeignHint
    primRepForeignHint :: PrimRep -> ForeignHint
    primRepForeignHint (BoxedRep Maybe Levity
    _) = ForeignHint
    AddrHint
    primRepForeignHint PrimRep
    IntRep       = ForeignHint
    SignedHint
    primRepForeignHint PrimRep
    Int8Rep      = ForeignHint
    SignedHint
    primRepForeignHint PrimRep
    Int16Rep     = ForeignHint
    SignedHint
    primRepForeignHint PrimRep
    Int32Rep     = ForeignHint
    SignedHint
    primRepForeignHint PrimRep
    Int64Rep     = ForeignHint
    SignedHint
    primRepForeignHint PrimRep
    WordRep      = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    Word8Rep     = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    Word16Rep    = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    Word32Rep    = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    Word64Rep    = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    AddrRep      = ForeignHint
    AddrHint -- NB! AddrHint, but NonPtrArg
    primRepForeignHint PrimRep
    FloatRep     = ForeignHint
    NoHint
    primRepForeignHint PrimRep
    DoubleRep    = ForeignHint
    NoHint
    primRepForeignHint (VecRep {})  = ForeignHint
    NoHint

    typeForeignHint :: NvUnaryType -> ForeignHint
    typeForeignHint :: NvUnaryType -> ForeignHint
    typeForeignHint = PrimRep -> ForeignHint
    primRepForeignHint (PrimRep -> ForeignHint)
    -> (NvUnaryType -> PrimRep) -> NvUnaryType -> ForeignHint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => NvUnaryType -> PrimRep
    NvUnaryType -> PrimRep
    typePrimRepU

    ---------------------------------------------------
    --
    --      CmmLit
    --
    ---------------------------------------------------

    -- XXX: should really be Integer, since Int doesn't necessarily cover
    -- the full range of target Ints.
    mkIntCLit :: Platform -> Int -> CmmLit
    mkIntCLit :: Platform -> Int -> CmmLit
    mkIntCLit Platform
    platform Int
    i = Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    i) (Platform -> Width
    wordWidth Platform
    platform)

    mkIntExpr :: Platform -> Int -> CmmExpr
    mkIntExpr :: Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform Int
    i = CmmLit -> CmmExpr
    CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $! Platform -> Int -> CmmLit
    mkIntCLit Platform
    platform Int
    i

    zeroCLit :: Platform -> CmmLit
    zeroCLit :: Platform -> CmmLit
    zeroCLit Platform
    platform = Integer -> Width -> CmmLit
    CmmInt Integer
    0 (Platform -> Width
    wordWidth Platform
    platform)

    zeroExpr :: Platform -> CmmExpr
    zeroExpr :: Platform -> CmmExpr
    zeroExpr Platform
    platform = CmmLit -> CmmExpr
    CmmLit (Platform -> CmmLit
    zeroCLit Platform
    platform)

    mkWordCLit :: Platform -> Integer -> CmmLit
    mkWordCLit :: Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform Integer
    wd = Integer -> Width -> CmmLit
    CmmInt Integer
    wd (Platform -> Width
    wordWidth Platform
    platform)

    -- | We make a top-level decl for the string, and return a label pointing to it
    mkByteStringCLit
      :: CLabel -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkByteStringCLit :: forall (raw :: Bool) info stmt.
    CLabel
    -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkByteStringCLit CLabel
    lbl ByteString
    bytes
      = (CLabel -> CmmLit
    CmmLabel CLabel
    lbl, Section
    -> GenCmmStatics raw -> GenCmmDecl (GenCmmStatics raw) info stmt
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    sec CLabel
    lbl) (GenCmmStatics raw -> GenCmmDecl (GenCmmStatics raw) info stmt)
    -> GenCmmStatics raw -> GenCmmDecl (GenCmmStatics raw) info stmt
    forall a b. (a -> b) -> a -> b
    $ CLabel -> [CmmStatic] -> GenCmmStatics raw
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [ByteString -> CmmStatic
    CmmString ByteString
    bytes])
      where
        -- This can not happen for String literals (as there \NUL is replaced by
        -- C0 80). However, it can happen with Addr# literals.
        sec :: SectionType
    sec = if Word8
    0 Word8 -> ByteString -> Bool
    `BS.elem` ByteString
    bytes then SectionType
    ReadOnlyData else SectionType
    CString

    -- | We make a top-level decl for the embedded binary file, and return a label pointing to it
    mkFileEmbedLit
      :: CLabel -> FilePath -> Int -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkFileEmbedLit :: forall (raw :: Bool) info stmt.
    CLabel
    -> FilePath
    -> Int
    -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkFileEmbedLit CLabel
    lbl FilePath
    path Int
    len
      = (CLabel -> CmmLit
    CmmLabel CLabel
    lbl, Section
    -> GenCmmStatics raw -> GenCmmDecl (GenCmmStatics raw) info stmt
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData (SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl) (CLabel -> [CmmStatic] -> GenCmmStatics raw
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [FilePath -> Int -> CmmStatic
    CmmFileEmbed FilePath
    path Int
    len]))

    -- | Build a data-segment data block
    mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkDataLits :: forall (raw :: Bool) info stmt.
    Section
    -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkDataLits Section
    section CLabel
    lbl [CmmLit]
    lits
      = Section
    -> GenCmmStatics raw -> GenCmmDecl (GenCmmStatics raw) info stmt
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    section (CLabel -> [CmmStatic] -> GenCmmStatics raw
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl ([CmmStatic] -> GenCmmStatics raw)
    -> [CmmStatic] -> GenCmmStatics raw
    forall a b. (a -> b) -> a -> b
    $ (CmmLit -> CmmStatic) -> [CmmLit] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmLit -> CmmStatic
    CmmStaticLit [CmmLit]
    lits)

    mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    -- Build a read-only data block
    mkRODataLits :: forall (raw :: Bool) info stmt.
    CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkRODataLits CLabel
    lbl [CmmLit]
    lits
      = Section
    -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    forall (raw :: Bool) info stmt.
    Section
    -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkDataLits Section
    section CLabel
    lbl [CmmLit]
    lits
      where
        section :: Section
    section | (CmmLit -> Bool) -> [CmmLit] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CmmLit -> Bool
    needsRelocation [CmmLit]
    lits = SectionType -> CLabel -> Section
    Section SectionType
    RelocatableReadOnlyData CLabel
    lbl
                | Bool
    otherwise                = SectionType -> CLabel -> Section
    Section SectionType
    ReadOnlyData CLabel
    lbl
        needsRelocation :: CmmLit -> Bool
    needsRelocation (CmmLabel CLabel
    _)      = Bool
    True
        needsRelocation (CmmLabelOff CLabel
    _ Int
    _) = Bool
    True
        needsRelocation CmmLit
    _                 = Bool
    False

    mkStgWordCLit :: Platform -> StgWord -> CmmLit
    mkStgWordCLit :: Platform -> StgWord -> CmmLit
    mkStgWordCLit Platform
    platform StgWord
    wd = Integer -> Width -> CmmLit
    CmmInt (StgWord -> Integer
    fromStgWord StgWord
    wd) (Platform -> Width
    wordWidth Platform
    platform)

    packHalfWordsCLit :: Platform -> StgHalfWord -> StgHalfWord -> CmmLit
    -- Make a single word literal in which the lower_half_word is
    -- at the lower address, and the upper_half_word is at the
    -- higher address
    -- ToDo: consider using half-word lits instead
    --       but be careful: that's vulnerable when reversed
    packHalfWordsCLit :: Platform -> StgHalfWord -> StgHalfWord -> CmmLit
    packHalfWordsCLit Platform
    platform StgHalfWord
    lower_half_word StgHalfWord
    upper_half_word
       = case Platform -> ByteOrder
    platformByteOrder Platform
    platform of
           ByteOrder
    BigEndian    -> Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform ((Integer
    l Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Platform -> Int
    halfWordSizeInBits Platform
    platform) Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    u)
           ByteOrder
    LittleEndian -> Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (Integer
    l Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. (Integer
    u Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Platform -> Int
    halfWordSizeInBits Platform
    platform))
        where l :: Integer
    l = StgHalfWord -> Integer
    fromStgHalfWord StgHalfWord
    lower_half_word
              u :: Integer
    u = StgHalfWord -> Integer
    fromStgHalfWord StgHalfWord
    upper_half_word

    ---------------------------------------------------
    --
    --      CmmExpr
    --
    ---------------------------------------------------

    mkLblExpr :: CLabel -> CmmExpr
    mkLblExpr :: CLabel -> CmmExpr
    mkLblExpr CLabel
    lbl = CmmLit -> CmmExpr
    CmmLit (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)

    cmmOffsetExpr :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    -- assumes base and offset have the same CmmType
    cmmOffsetExpr :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExpr Platform
    platform CmmExpr
    e (CmmLit (CmmInt Integer
    n Width
    _)) = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    e (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
    cmmOffsetExpr Platform
    platform CmmExpr
    e CmmExpr
    byte_off = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add (Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e)) [CmmExpr
    e, CmmExpr
    byte_off]

    cmmOffset :: Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset :: Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    _platform CmmExpr
    e Int
    0        = CmmExpr
    e
    cmmOffset Platform
    platform  CmmExpr
    e Int
    byte_off = case CmmExpr
    e of
       CmmReg CmmReg
    reg            -> CmmReg -> Int -> CmmExpr
    cmmRegOff CmmReg
    reg Int
    byte_off
       CmmRegOff CmmReg
    reg Int
    m       -> CmmReg -> Int -> CmmExpr
    cmmRegOff CmmReg
    reg (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    byte_off)
       CmmLit CmmLit
    lit            -> CmmLit -> CmmExpr
    CmmLit (CmmLit -> Int -> CmmLit
    cmmOffsetLit CmmLit
    lit Int
    byte_off)
       CmmStackSlot Area
    area Int
    off -> Area -> Int -> CmmExpr
    CmmStackSlot Area
    area (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    byte_off)
      -- note stack area offsets increase towards lower addresses
       CmmMachOp (MO_Add Width
    rep) [CmmExpr
    expr, CmmLit (CmmInt Integer
    byte_off1 Width
    _rep)]
          -> let !lit_off :: Integer
    lit_off = (Integer
    byte_off1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    byte_off)
             in MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    rep) [CmmExpr
    expr, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt Integer
    lit_off Width
    rep)]
       CmmExpr
    _ -> let !width :: Width
    width = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e
            in
            MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    width) [CmmExpr
    e, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    byte_off) Width
    width)]

    -- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
    cmmRegOff :: CmmReg -> Int -> CmmExpr
    cmmRegOff :: CmmReg -> Int -> CmmExpr
    cmmRegOff CmmReg
    reg Int
    0        = CmmReg -> CmmExpr
    CmmReg CmmReg
    reg
    cmmRegOff CmmReg
    reg Int
    byte_off = CmmReg -> Int -> CmmExpr
    CmmRegOff CmmReg
    reg Int
    byte_off

    cmmOffsetLit :: CmmLit -> Int -> CmmLit
    cmmOffsetLit :: CmmLit -> Int -> CmmLit
    cmmOffsetLit (CmmLabel CLabel
    l)      Int
    byte_off = CLabel -> Int -> CmmLit
    cmmLabelOff CLabel
    l Int
    byte_off
    cmmOffsetLit (CmmLabelOff CLabel
    l Int
    m) Int
    byte_off = CLabel -> Int -> CmmLit
    cmmLabelOff CLabel
    l (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    byte_off)
    cmmOffsetLit (CmmLabelDiffOff CLabel
    l1 CLabel
    l2 Int
    m Width
    w) Int
    byte_off
                                            = CLabel -> CLabel -> Int -> Width -> CmmLit
    CmmLabelDiffOff CLabel
    l1 CLabel
    l2 (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    byte_off) Width
    w
    cmmOffsetLit (CmmInt Integer
    m Width
    rep)    Int
    byte_off = Integer -> Width -> CmmLit
    CmmInt (Integer
    m Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    byte_off) Width
    rep
    cmmOffsetLit CmmLit
    _                 Int
    byte_off = FilePath -> SDoc -> CmmLit
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "cmmOffsetLit" (Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    byte_off)

    cmmLabelOff :: CLabel -> Int -> CmmLit
    -- Smart constructor for CmmLabelOff
    cmmLabelOff :: CLabel -> Int -> CmmLit
    cmmLabelOff CLabel
    lbl Int
    0        = CLabel -> CmmLit
    CmmLabel CLabel
    lbl
    cmmLabelOff CLabel
    lbl Int
    byte_off = CLabel -> Int -> CmmLit
    CmmLabelOff CLabel
    lbl Int
    byte_off

    -- | Useful for creating an index into an array, with a statically known offset.
    -- The type is the element type; used for making the multiplier
    cmmIndex :: Platform
             -> Width       -- Width w
             -> CmmExpr     -- Address of vector of items of width w
             -> Int         -- Which element of the vector (0 based)
             -> CmmExpr     -- Address of i'th element
    cmmIndex :: Platform -> Width -> CmmExpr -> Int -> CmmExpr
    cmmIndex Platform
    platform Width
    width CmmExpr
    base Int
    idx = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    base (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Width -> Int
    widthInBytes Width
    width)

    -- | Useful for creating an index into an array, with an unknown offset.
    cmmIndexExpr :: Platform
                 -> Width           -- Width w
                 -> CmmExpr         -- Address of vector of items of width w
                 -> CmmExpr         -- Which element of the vector (0 based)
                 -> CmmExpr         -- Address of i'th element
    cmmIndexExpr :: Platform -> Width -> CmmExpr -> CmmExpr -> CmmExpr
    cmmIndexExpr Platform
    platform Width
    width CmmExpr
    base (CmmLit (CmmInt Integer
    n Width
    _)) = Platform -> Width -> CmmExpr -> Int -> CmmExpr
    cmmIndex Platform
    platform Width
    width CmmExpr
    base (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
    cmmIndexExpr Platform
    platform Width
    width CmmExpr
    base CmmExpr
    idx =
      Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExpr Platform
    platform CmmExpr
    base CmmExpr
    byte_off
      where
        idx_w :: Width
    idx_w = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    idx
        byte_off :: CmmExpr
    byte_off = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Shl Width
    idx_w) [CmmExpr
    idx, Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (Width -> Int
    widthInLog Width
    width)]

    cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr
    cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr
    cmmLoadIndex Platform
    platform CmmType
    ty CmmExpr
    expr Int
    ix =
        CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (Platform -> Width -> CmmExpr -> Int -> CmmExpr
    cmmIndex Platform
    platform (CmmType -> Width
    typeWidth CmmType
    ty) CmmExpr
    expr Int
    ix) CmmType
    ty AlignmentSpec
    NaturallyAligned -- TODO: Audit uses

    -- | Load a naturally-aligned non-pointer word.
    cmmLoadBWord :: Platform -> CmmExpr -> CmmExpr
    cmmLoadBWord :: Platform -> CmmExpr -> CmmExpr
    cmmLoadBWord Platform
    platform CmmExpr
    ptr = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    ptr (Platform -> CmmType
    bWord Platform
    platform) AlignmentSpec
    NaturallyAligned

    -- | Load a naturally-aligned GC pointer.
    cmmLoadGCWord :: Platform -> CmmExpr -> CmmExpr
    cmmLoadGCWord :: Platform -> CmmExpr -> CmmExpr
    cmmLoadGCWord Platform
    platform CmmExpr
    ptr = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    ptr (Platform -> CmmType
    gcWord Platform
    platform) AlignmentSpec
    NaturallyAligned

    -- The "B" variants take byte offsets
    cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
    cmmRegOffB :: CmmReg -> Int -> CmmExpr
    cmmRegOffB = CmmReg -> Int -> CmmExpr
    cmmRegOff

    cmmOffsetB :: Platform -> CmmExpr -> ByteOff -> CmmExpr
    cmmOffsetB :: Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset

    cmmOffsetExprB :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExprB :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExprB = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExpr

    cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
    cmmLabelOffB :: CLabel -> Int -> CmmLit
    cmmLabelOffB = CLabel -> Int -> CmmLit
    cmmLabelOff

    cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
    cmmOffsetLitB :: CmmLit -> Int -> CmmLit
    cmmOffsetLitB = CmmLit -> Int -> CmmLit
    cmmOffsetLit

    -----------------------
    -- The "W" variants take word offsets

    cmmOffsetExprW :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    -- The second arg is a *word* offset; need to change it to bytes
    cmmOffsetExprW :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExprW Platform
    platform  CmmExpr
    e (CmmLit (CmmInt Integer
    n Width
    _)) = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    e (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
    cmmOffsetExprW Platform
    platform CmmExpr
    e CmmExpr
    wd_off = Platform -> Width -> CmmExpr -> CmmExpr -> CmmExpr
    cmmIndexExpr Platform
    platform (Platform -> Width
    wordWidth Platform
    platform) CmmExpr
    e CmmExpr
    wd_off

    cmmOffsetW :: Platform -> CmmExpr -> WordOff -> CmmExpr
    cmmOffsetW :: Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    e Int
    n = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    e (Platform -> Int -> Int
    forall a. Num a => Platform -> a -> a
    wordsToBytes Platform
    platform Int
    n)

    cmmRegOffW :: Platform -> CmmReg -> WordOff -> CmmExpr
    cmmRegOffW :: Platform -> CmmReg -> Int -> CmmExpr
    cmmRegOffW Platform
    platform CmmReg
    reg Int
    wd_off = CmmReg -> Int -> CmmExpr
    cmmRegOffB CmmReg
    reg (Platform -> Int -> Int
    forall a. Num a => Platform -> a -> a
    wordsToBytes Platform
    platform Int
    wd_off)

    cmmOffsetLitW :: Platform -> CmmLit -> WordOff -> CmmLit
    cmmOffsetLitW :: Platform -> CmmLit -> Int -> CmmLit
    cmmOffsetLitW Platform
    platform CmmLit
    lit Int
    wd_off = CmmLit -> Int -> CmmLit
    cmmOffsetLitB CmmLit
    lit (Platform -> Int -> Int
    forall a. Num a => Platform -> a -> a
    wordsToBytes Platform
    platform Int
    wd_off)

    cmmLabelOffW :: Platform -> CLabel -> WordOff -> CmmLit
    cmmLabelOffW :: Platform -> CLabel -> Int -> CmmLit
    cmmLabelOffW Platform
    platform CLabel
    lbl Int
    wd_off = CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    lbl (Platform -> Int -> Int
    forall a. Num a => Platform -> a -> a
    wordsToBytes Platform
    platform Int
    wd_off)

    cmmLoadIndexW :: Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
    cmmLoadIndexW :: Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
    cmmLoadIndexW Platform
    platform CmmExpr
    base Int
    off CmmType
    ty =
        CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    base Int
    off) CmmType
    ty AlignmentSpec
    NaturallyAligned -- TODO: Audit ses

    -----------------------
    cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,
      cmmSLtWord,
      cmmNeWord, cmmEqWord,
      cmmOrWord, cmmAndWord,
      cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord
      :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOrWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOrWord Platform
    platform  CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordOr Platform
    platform)  [CmmExpr
    e1, CmmExpr
    e2]
    cmmAndWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordAnd Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmNeWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmNeWord Platform
    platform  CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordNe Platform
    platform)  [CmmExpr
    e1, CmmExpr
    e2]
    cmmEqWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform  CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordEq Platform
    platform)  [CmmExpr
    e1, CmmExpr
    e2]
    cmmULtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmULtWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordULt Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmUGeWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmUGeWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUGe Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmUGtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmUGtWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUGt Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmSLtWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmSLtWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordSLt Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmUShrWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmUShrWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUShr Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmAddWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAddWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordAdd Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmSubWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmSubWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordSub Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmMulWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmMulWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordMul Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]
    cmmQuotWord :: Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmQuotWord Platform
    platform CmmExpr
    e1 CmmExpr
    e2 = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUQuot Platform
    platform) [CmmExpr
    e1, CmmExpr
    e2]

    cmmNegate :: Platform -> CmmExpr -> CmmExpr
    cmmNegate :: Platform -> CmmExpr -> CmmExpr
    cmmNegate Platform
    platform = \case
       (CmmLit (CmmInt Integer
    n Width
    rep))
         -> CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (-Integer
    n) Width
    rep)
       CmmExpr
    e -> MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_S_Neg (Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e)) [CmmExpr
    e]

    cmmToWord :: Platform -> CmmExpr -> CmmExpr
    cmmToWord :: Platform -> CmmExpr -> CmmExpr
    cmmToWord Platform
    platform CmmExpr
    e
      | Width
    w Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    word  = CmmExpr
    e
      | Bool
    otherwise  = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv Width
    w Width
    word) [CmmExpr
    e]
      where
        w :: Width
    w = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e
        word :: Width
    word = Platform -> Width
    wordWidth Platform
    platform

    cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)
    cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)
    cmmMkAssign Platform
    platform CmmExpr
    expr Unique
    uq =
      let !ty :: CmmType
    ty = Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    expr
          reg :: CmmReg
    reg = (LocalReg -> CmmReg
    CmmLocal (Unique -> CmmType -> LocalReg
    LocalReg Unique
    uq CmmType
    ty))
      in  (CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign CmmReg
    reg CmmExpr
    expr, CmmReg -> CmmExpr
    CmmReg CmmReg
    reg)

    ---------------------------------------------------
    --
    --      Tagging
    --
    ---------------------------------------------------

    tAG_MASK :: Platform -> Int
    tAG_MASK :: Platform -> Int
    tAG_MASK Platform
    platform = (Int
    1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` PlatformConstants -> Int
    pc_TAG_BITS (Platform -> PlatformConstants
    platformConstants Platform
    platform)) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

    mAX_PTR_TAG :: Platform -> Int
    mAX_PTR_TAG :: Platform -> Int
    mAX_PTR_TAG = Platform -> Int
    tAG_MASK

    -- Tag bits mask
    cmmTagMask, cmmPointerMask :: Platform -> CmmExpr
    cmmTagMask :: Platform -> CmmExpr
    cmmTagMask Platform
    platform = Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (Platform -> Int
    tAG_MASK Platform
    platform)
    cmmPointerMask :: Platform -> CmmExpr
    cmmPointerMask Platform
    platform = Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (Int -> Int
    forall a. Bits a => a -> a
    complement (Platform -> Int
    tAG_MASK Platform
    platform))

    -- Used to untag a possibly tagged pointer
    -- A static label need not be untagged
    cmmUntag, cmmIsTagged, cmmIsNotTagged, cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr
    cmmUntag :: Platform -> CmmExpr -> CmmExpr
    cmmUntag Platform
    _ e :: CmmExpr
    e@(CmmLit (CmmLabel CLabel
    _)) = CmmExpr
    e
    -- Default case
    cmmUntag Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform CmmExpr
    e (Platform -> CmmExpr
    cmmPointerMask Platform
    platform)

    -- Test if a closure pointer is untagged/tagged.
    cmmIsTagged :: Platform -> CmmExpr -> CmmExpr
    cmmIsTagged Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmNeWord Platform
    platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform CmmExpr
    e (Platform -> CmmExpr
    cmmTagMask Platform
    platform)) (Platform -> CmmExpr
    zeroExpr Platform
    platform)
    cmmIsNotTagged :: Platform -> CmmExpr -> CmmExpr
    cmmIsNotTagged Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform CmmExpr
    e (Platform -> CmmExpr
    cmmTagMask Platform
    platform)) (Platform -> CmmExpr
    zeroExpr Platform
    platform)

    -- Get constructor tag, but one based.
    cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr
    cmmConstrTag1 Platform
    platform CmmExpr
    e = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform CmmExpr
    e (Platform -> CmmExpr
    cmmTagMask Platform
    platform)

    -----------------------------------------------------------------------------
    -- Overlap and usage

    -- | Returns True if the two STG registers overlap on the specified
    -- platform, in the sense that writing to one will clobber the
    -- other. This includes the case that the two registers are the same
    -- STG register. See Note [Overlapping global registers] for details.
    regsOverlap :: Platform -> CmmReg -> CmmReg -> Bool
    regsOverlap :: Platform -> CmmReg -> CmmReg -> Bool
    regsOverlap Platform
    platform (CmmGlobal (GlobalRegUse GlobalReg
    g1 CmmType
    _)) (CmmGlobal (GlobalRegUse GlobalReg
    g2 CmmType
    _))
      = Platform -> GlobalReg -> GlobalReg -> Bool
    globalRegsOverlap Platform
    platform GlobalReg
    g1 GlobalReg
    g2
    regsOverlap Platform
    _ CmmReg
    reg CmmReg
    reg' = CmmReg
    reg CmmReg -> CmmReg -> Bool
    forall a. Eq a => a -> a -> Bool
    == CmmReg
    reg'

    globalRegsOverlap :: Platform -> GlobalReg -> GlobalReg -> Bool
    globalRegsOverlap :: Platform -> GlobalReg -> GlobalReg -> Bool
    globalRegsOverlap Platform
    platform GlobalReg
    g1 GlobalReg
    g2
      | Just RealReg
    real  <- Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform GlobalReg
    g1
      , Just RealReg
    real' <- Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform GlobalReg
    g2
      , RealReg
    real RealReg -> RealReg -> Bool
    forall a. Eq a => a -> a -> Bool
    == RealReg
    real'
      = Bool
    True
      | Bool
    otherwise
      = GlobalReg
    g1 GlobalReg -> GlobalReg -> Bool
    forall a. Eq a => a -> a -> Bool
    == GlobalReg
    g2

    -- | Returns True if the STG register is used by the expression, in
    -- the sense that a store to the register might affect the value of
    -- the expression.
    --
    -- We must check for overlapping registers and not just equal
    -- registers here, otherwise CmmSink may incorrectly reorder
    -- assignments that conflict due to overlap. See #10521 and Note
    -- [Overlapping global registers].
    regUsedIn :: Platform -> CmmReg -> CmmExpr -> Bool
    regUsedIn :: Platform -> CmmReg -> CmmExpr -> Bool
    regUsedIn Platform
    platform = CmmReg -> CmmExpr -> Bool
    regUsedIn_ where
      CmmReg
    _   regUsedIn_ :: CmmReg -> CmmExpr -> Bool
    `regUsedIn_` CmmLit CmmLit
    _         = Bool
    False
      CmmReg
    reg `regUsedIn_` CmmLoad CmmExpr
    e CmmType
    _ AlignmentSpec
    _    = CmmReg
    reg CmmReg -> CmmExpr -> Bool
    `regUsedIn_` CmmExpr
    e
      CmmReg
    reg `regUsedIn_` CmmReg CmmReg
    reg'      = Platform -> CmmReg -> CmmReg -> Bool
    regsOverlap Platform
    platform CmmReg
    reg CmmReg
    reg'
      CmmReg
    reg `regUsedIn_` CmmRegOff CmmReg
    reg' Int
    _ = Platform -> CmmReg -> CmmReg -> Bool
    regsOverlap Platform
    platform CmmReg
    reg CmmReg
    reg'
      CmmReg
    reg `regUsedIn_` CmmMachOp MachOp
    _ [CmmExpr]
    es   = (CmmExpr -> Bool) -> [CmmExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (CmmReg
    reg CmmReg -> CmmExpr -> Bool
    `regUsedIn_`) [CmmExpr]
    es
      CmmReg
    _   `regUsedIn_` CmmStackSlot Area
    _ Int
    _ = Bool
    False

    globalRegUsedIn :: Platform -> GlobalReg -> CmmExpr -> Bool
    globalRegUsedIn :: Platform -> GlobalReg -> CmmExpr -> Bool
    globalRegUsedIn Platform
    platform = GlobalReg -> CmmExpr -> Bool
    globalRegUsedIn_ where
      GlobalReg
    _   globalRegUsedIn_ :: GlobalReg -> CmmExpr -> Bool
    `globalRegUsedIn_` CmmLit CmmLit
    _
        = Bool
    False
      GlobalReg
    reg `globalRegUsedIn_` CmmLoad CmmExpr
    e CmmType
    _ AlignmentSpec
    _
        = GlobalReg
    reg GlobalReg -> CmmExpr -> Bool
    `globalRegUsedIn_` CmmExpr
    e
      GlobalReg
    reg `globalRegUsedIn_` CmmReg CmmReg
    reg'
        | CmmGlobal (GlobalRegUse GlobalReg
    reg' CmmType
    _) <- CmmReg
    reg'
        = Platform -> GlobalReg -> GlobalReg -> Bool
    globalRegsOverlap Platform
    platform GlobalReg
    reg GlobalReg
    reg'
        | Bool
    otherwise
        = Bool
    False
      GlobalReg
    reg `globalRegUsedIn_` CmmRegOff CmmReg
    reg' Int
    _
        | CmmGlobal (GlobalRegUse GlobalReg
    reg' CmmType
    _) <- CmmReg
    reg'
        = Platform -> GlobalReg -> GlobalReg -> Bool
    globalRegsOverlap Platform
    platform GlobalReg
    reg GlobalReg
    reg'
        | Bool
    otherwise
        = Bool
    False
      GlobalReg
    reg `globalRegUsedIn_` CmmMachOp MachOp
    _ [CmmExpr]
    es
        = (CmmExpr -> Bool) -> [CmmExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (GlobalReg
    reg GlobalReg -> CmmExpr -> Bool
    `globalRegUsedIn_`) [CmmExpr]
    es
      GlobalReg
    _   `globalRegUsedIn_` CmmStackSlot Area
    _ Int
    _
        = Bool
    False

    --------------------------------------------
    --
    --        mkLiveness
    --
    ---------------------------------------------

    mkLiveness :: Platform -> [LocalReg] -> Liveness
    mkLiveness :: Platform -> [LocalReg] -> Liveness
    mkLiveness Platform
    _      [] = []
    mkLiveness Platform
    platform (LocalReg
    reg:[LocalReg]
    regs)
      = Liveness
    bits Liveness -> Liveness -> Liveness
    forall a. [a] -> [a] -> [a]
    ++ Platform -> [LocalReg] -> Liveness
    mkLiveness Platform
    platform [LocalReg]
    regs
      where
        word_size :: Int
    word_size = Platform -> Int
    platformWordSizeInBytes Platform
    platform
        sizeW :: Int
    sizeW = (Width -> Int
    widthInBytes (CmmType -> Width
    typeWidth (LocalReg -> CmmType
    localRegType LocalReg
    reg)) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    word_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    word_size
                -- number of words, rounded up
        bits :: Liveness
    bits = Int -> Bool -> Liveness
    forall a. Int -> a -> [a]
    replicate Int
    sizeW Bool
    is_non_ptr -- True <=> Non Ptr

        is_non_ptr :: Bool
    is_non_ptr = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ CmmType -> Bool
    isGcPtrType (LocalReg -> CmmType
    localRegType LocalReg
    reg)

    -- ============================================== -
    -- ============================================== -
    -- ============================================== -

    ---------------------------------------------------
    --
    --      Manipulating CmmGraphs
    --
    ---------------------------------------------------

    modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
    modifyGraph :: forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *).
    (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
    modifyGraph Graph n C C -> Graph n' C C
    f GenCmmGraph n
    g = CmmGraph {g_entry :: BlockId
    g_entry=GenCmmGraph n -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph n
    g, g_graph :: Graph n' C C
    g_graph=Graph n C C -> Graph n' C C
    f (GenCmmGraph n -> Graph n C C
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Graph n C C
    g_graph GenCmmGraph n
    g)}

    ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
    ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
    ofBlockMap BlockId
    entry LabelMap CmmBlock
    bodyMap = CmmGraph {g_entry :: BlockId
    g_entry=BlockId
    entry, g_graph :: Graph CmmNode C C
    g_graph=MaybeO C (Block CmmNode O C)
    -> LabelMap CmmBlock
    -> MaybeO C (Block CmmNode C O)
    -> Graph CmmNode C C
    forall (e :: Extensibility)
           (block :: (Extensibility -> Extensibility -> *)
                     -> Extensibility -> Extensibility -> *)
           (n :: Extensibility -> Extensibility -> *) (x :: Extensibility).
    MaybeO e (block n O C)
    -> Body' block n -> MaybeO x (block n C O) -> Graph' block n e x
    GMany MaybeO C (Block CmmNode O C)
    forall t. MaybeO C t
    NothingO LabelMap CmmBlock
    bodyMap MaybeO C (Block CmmNode C O)
    forall t. MaybeO C t
    NothingO}

    -- | like 'toBlockList', but the entry block always comes first
    toBlockListEntryFirst :: CmmGraph -> [CmmBlock]
    toBlockListEntryFirst :: CmmGraph -> [CmmBlock]
    toBlockListEntryFirst CmmGraph
    g
      | LabelMap CmmBlock -> Bool
    forall a. LabelMap a -> Bool
    mapNull LabelMap CmmBlock
    m  = []
      | Bool
    otherwise  = CmmBlock
    entry_block CmmBlock -> [CmmBlock] -> [CmmBlock]
    forall a. a -> [a] -> [a]
    : [CmmBlock]
    others
      where
        m :: LabelMap CmmBlock
    m = CmmGraph -> LabelMap CmmBlock
    toBlockMap CmmGraph
    g
        entry_id :: BlockId
    entry_id = CmmGraph -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    g
        Just CmmBlock
    entry_block = BlockId -> LabelMap CmmBlock -> Maybe CmmBlock
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    entry_id LabelMap CmmBlock
    m
        others :: [CmmBlock]
    others = (CmmBlock -> Bool) -> [CmmBlock] -> [CmmBlock]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BlockId
    entry_id) (BlockId -> Bool) -> (CmmBlock -> BlockId) -> CmmBlock -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmBlock -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel) (LabelMap CmmBlock -> [CmmBlock]
    forall a. LabelMap a -> [a]
    mapElems LabelMap CmmBlock
    m)

    -- | Like 'toBlockListEntryFirst', but we strive to ensure that we order blocks
    -- so that the false case of a conditional jumps to the next block in the output
    -- list of blocks. This matches the way OldCmm blocks were output since in
    -- OldCmm the false case was a fallthrough, whereas in Cmm conditional branches
    -- have both true and false successors. Block ordering can make a big difference
    -- in performance in the LLVM backend. Note that we rely crucially on the order
    -- of successors returned for CmmCondBranch by the NonLocal instance for CmmNode
    -- defined in "GHC.Cmm.Node". -GBM
    toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]
    toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]
    toBlockListEntryFirstFalseFallthrough CmmGraph
    g
      | LabelMap CmmBlock -> Bool
    forall a. LabelMap a -> Bool
    mapNull LabelMap CmmBlock
    m  = []
      | Bool
    otherwise  = LabelSet -> [CmmBlock] -> [CmmBlock]
    dfs LabelSet
    setEmpty [CmmBlock
    entry_block]
      where
        m :: LabelMap CmmBlock
    m = CmmGraph -> LabelMap CmmBlock
    toBlockMap CmmGraph
    g
        entry_id :: BlockId
    entry_id = CmmGraph -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    g
        Just CmmBlock
    entry_block = BlockId -> LabelMap CmmBlock -> Maybe CmmBlock
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    entry_id LabelMap CmmBlock
    m

        dfs :: LabelSet -> [CmmBlock] -> [CmmBlock]
        dfs :: LabelSet -> [CmmBlock] -> [CmmBlock]
    dfs LabelSet
    _ [] = []
        dfs LabelSet
    visited (CmmBlock
    block:[CmmBlock]
    bs)
          | BlockId
    id BlockId -> LabelSet -> Bool
    `setMember` LabelSet
    visited = LabelSet -> [CmmBlock] -> [CmmBlock]
    dfs LabelSet
    visited [CmmBlock]
    bs
          | Bool
    otherwise              = CmmBlock
    block CmmBlock -> [CmmBlock] -> [CmmBlock]
    forall a. a -> [a] -> [a]
    : LabelSet -> [CmmBlock] -> [CmmBlock]
    dfs (BlockId -> LabelSet -> LabelSet
    setInsert BlockId
    id LabelSet
    visited) [CmmBlock]
    bs'
          where id :: BlockId
    id = CmmBlock -> BlockId
    forall (x :: Extensibility). Block CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    block
                bs' :: [CmmBlock]
    bs' = (BlockId -> [CmmBlock] -> [CmmBlock])
    -> [CmmBlock] -> [BlockId] -> [CmmBlock]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr BlockId -> [CmmBlock] -> [CmmBlock]
    add_id [CmmBlock]
    bs (CmmBlock -> [BlockId]
    forall (e :: Extensibility). Block CmmNode e C -> [BlockId]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmBlock
    block)
                add_id :: BlockId -> [CmmBlock] -> [CmmBlock]
    add_id BlockId
    id [CmmBlock]
    bs = case BlockId -> LabelMap CmmBlock -> Maybe CmmBlock
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    id LabelMap CmmBlock
    m of
                                  Just CmmBlock
    b  -> CmmBlock
    b CmmBlock -> [CmmBlock] -> [CmmBlock]
    forall a. a -> [a] -> [a]
    : [CmmBlock]
    bs
                                  Maybe CmmBlock
    Nothing -> [CmmBlock]
    bs

    ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
    ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
    ofBlockList BlockId
    entry [CmmBlock]
    blocks = CmmGraph { g_entry :: BlockId
    g_entry = BlockId
    entry
                                        , g_graph :: Graph CmmNode C C
    g_graph = MaybeO C (Block CmmNode O C)
    -> LabelMap CmmBlock
    -> MaybeO C (Block CmmNode C O)
    -> Graph CmmNode C C
    forall (e :: Extensibility)
           (block :: (Extensibility -> Extensibility -> *)
                     -> Extensibility -> Extensibility -> *)
           (n :: Extensibility -> Extensibility -> *) (x :: Extensibility).
    MaybeO e (block n O C)
    -> Body' block n -> MaybeO x (block n C O) -> Graph' block n e x
    GMany MaybeO C (Block CmmNode O C)
    forall t. MaybeO C t
    NothingO LabelMap CmmBlock
    body MaybeO C (Block CmmNode C O)
    forall t. MaybeO C t
    NothingO }
      where body :: LabelMap CmmBlock
    body = (CmmBlock -> LabelMap CmmBlock -> LabelMap CmmBlock)
    -> LabelMap CmmBlock -> [CmmBlock] -> LabelMap CmmBlock
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CmmBlock -> LabelMap CmmBlock -> LabelMap CmmBlock
    forall (block :: Extensibility -> Extensibility -> *).
    (NonLocal block, HasDebugCallStack) =>
    block C C -> LabelMap (block C C) -> LabelMap (block C C)
    addBlock LabelMap CmmBlock
    forall (block :: (Extensibility -> Extensibility -> *)
                     -> Extensibility -> Extensibility -> *)
           (n :: Extensibility -> Extensibility -> *).
    Body' block n
    emptyBody [CmmBlock]
    blocks

    mapGraphNodes :: ( CmmNode C O -> CmmNode C O
                     , CmmNode O O -> CmmNode O O
                     , CmmNode O C -> CmmNode O C)
                  -> CmmGraph -> CmmGraph
    mapGraphNodes :: (CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O,
     CmmNode O C -> CmmNode O C)
    -> CmmGraph -> CmmGraph
    mapGraphNodes funs :: (CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O,
     CmmNode O C -> CmmNode O C)
    funs@(CmmNode C O -> CmmNode C O
    mf,CmmNode O O -> CmmNode O O
    _,CmmNode O C -> CmmNode O C
    _) CmmGraph
    g =
      BlockId -> LabelMap CmmBlock -> CmmGraph
    ofBlockMap (CmmNode C O -> BlockId
    forall (x :: Extensibility). CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel (CmmNode C O -> BlockId) -> CmmNode C O -> BlockId
    forall a b. (a -> b) -> a -> b
    $ CmmNode C O -> CmmNode C O
    mf (CmmNode C O -> CmmNode C O) -> CmmNode C O -> CmmNode C O
    forall a b. (a -> b) -> a -> b
    $ BlockId -> CmmTickScope -> CmmNode C O
    CmmEntry (CmmGraph -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    g) CmmTickScope
    GlobalScope) (LabelMap CmmBlock -> CmmGraph) -> LabelMap CmmBlock -> CmmGraph
    forall a b. (a -> b) -> a -> b
    $
      (CmmBlock -> CmmBlock) -> LabelMap CmmBlock -> LabelMap CmmBlock
    forall a v. (a -> v) -> LabelMap a -> LabelMap v
    mapMap ((CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O,
     CmmNode O C -> CmmNode O C)
    -> CmmBlock -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *) (e :: Extensibility)
           (x :: Extensibility).
    (n C O -> n' C O, n O O -> n' O O, n O C -> n' O C)
    -> Block n e x -> Block n' e x
    mapBlock3' (CmmNode C O -> CmmNode C O, CmmNode O O -> CmmNode O O,
     CmmNode O C -> CmmNode O C)
    funs) (LabelMap CmmBlock -> LabelMap CmmBlock)
    -> LabelMap CmmBlock -> LabelMap CmmBlock
    forall a b. (a -> b) -> a -> b
    $ CmmGraph -> LabelMap CmmBlock
    toBlockMap CmmGraph
    g

    mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph
    mapGraphNodes1 :: (forall (e :: Extensibility) (x :: Extensibility).
     CmmNode e x -> CmmNode e x)
    -> CmmGraph -> CmmGraph
    mapGraphNodes1 forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    f = (Graph CmmNode C C -> Graph CmmNode C C) -> CmmGraph -> CmmGraph
    forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *).
    (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
    modifyGraph ((forall (e :: Extensibility) (x :: Extensibility).
     CmmNode e x -> CmmNode e x)
    -> Graph CmmNode C C -> Graph CmmNode C C
    forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *) (e :: Extensibility)
           (x :: Extensibility).
    (forall (e1 :: Extensibility) (x1 :: Extensibility).
     n e1 x1 -> n' e1 x1)
    -> Graph n e x -> Graph n' e x
    mapGraph CmmNode e1 x1 -> CmmNode e1 x1
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> CmmNode e x
    f)

    foldlGraphBlocks :: (a -> CmmBlock -> a) -> a -> CmmGraph -> a
    foldlGraphBlocks :: forall a. (a -> CmmBlock -> a) -> a -> CmmGraph -> a
    foldlGraphBlocks a -> CmmBlock -> a
    k a
    z CmmGraph
    g = (a -> CmmBlock -> a) -> a -> LabelMap CmmBlock -> a
    forall a b. (a -> b -> a) -> a -> LabelMap b -> a
    mapFoldl a -> CmmBlock -> a
    k a
    z (LabelMap CmmBlock -> a) -> LabelMap CmmBlock -> a
    forall a b. (a -> b) -> a -> b
    $ CmmGraph -> LabelMap CmmBlock
    toBlockMap CmmGraph
    g

    -------------------------------------------------
    -- Tick utilities

    -- | Extract all tick annotations from the given block
    blockTicks :: Block CmmNode C C -> [CmmTickish]
    blockTicks :: CmmBlock -> [CmmTickish]
    blockTicks CmmBlock
    b = [CmmTickish] -> [CmmTickish]
    forall a. [a] -> [a]
    reverse ([CmmTickish] -> [CmmTickish]) -> [CmmTickish] -> [CmmTickish]
    forall a b. (a -> b) -> a -> b
    $ (forall (e :: Extensibility) (x :: Extensibility).
     CmmNode e x -> [CmmTickish] -> [CmmTickish])
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block CmmNode e x
       -> IndexedCO e [CmmTickish] [CmmTickish]
       -> IndexedCO x [CmmTickish] [CmmTickish]
    forall (n :: Extensibility -> Extensibility -> *) a.
    (forall (e :: Extensibility) (x :: Extensibility). n e x -> a -> a)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block n e x -> IndexedCO e a a -> IndexedCO x a a
    foldBlockNodesF CmmNode e x -> [CmmTickish] -> [CmmTickish]
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> [CmmTickish] -> [CmmTickish]
    goStmt CmmBlock
    b []
      where goStmt :: CmmNode e x -> [CmmTickish] -> [CmmTickish]
            goStmt :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> [CmmTickish] -> [CmmTickish]
    goStmt  (CmmTick CmmTickish
    t) [CmmTickish]
    ts = CmmTickish
    tCmmTickish -> [CmmTickish] -> [CmmTickish]
    forall a. a -> [a] -> [a]
    :[CmmTickish]
    ts
            goStmt  CmmNode e x
    _other      [CmmTickish]
    ts = [CmmTickish]
    ts

    -- -----------------------------------------------------------------------------
    -- Access to common global registers

    baseExpr, spExpr, hpExpr, currentTSOExpr, currentNurseryExpr,
      spLimExpr, hpLimExpr, cccsExpr :: Platform -> CmmExpr
    baseExpr :: Platform -> CmmExpr
    baseExpr           Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    baseReg           Platform
    p
    spExpr :: Platform -> CmmExpr
    spExpr             Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    spReg             Platform
    p
    spLimExpr :: Platform -> CmmExpr
    spLimExpr          Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    spLimReg          Platform
    p
    hpExpr :: Platform -> CmmExpr
    hpExpr             Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    hpReg             Platform
    p
    hpLimExpr :: Platform -> CmmExpr
    hpLimExpr          Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    hpLimReg          Platform
    p
    currentTSOExpr :: Platform -> CmmExpr
    currentTSOExpr     Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    currentTSOReg     Platform
    p
    currentNurseryExpr :: Platform -> CmmExpr
    currentNurseryExpr Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    currentNurseryReg Platform
    p
    cccsExpr :: Platform -> CmmExpr
    cccsExpr           Platform
    p = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    cccsReg           Platform
    p