    -----------------------------------------------------------------------------
    --
    -- Code generation for profiling
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    module GHC.StgToCmm.Prof (
            initCostCentres, ccType, ccsType,
            mkCCostCentre, mkCCostCentreStack,

            -- infoTablePRov
            initInfoTableProv,

            -- Cost-centre Profiling
            dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
            enterCostCentreThunk, enterCostCentreFun,
            costCentreFrom,
            storeCurCCS,
            emitSetCCC,

            saveCurrentCostCentre, restoreCurrentCostCentre,

            -- Lag/drag/void stuff
            ldvEnter, ldvEnterClosure, profHeaderCreate
      ) where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Config
    import GHC.StgToCmm.InfoTableProv
    import GHC.StgToCmm.Utils
    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Lit
    import GHC.Runtime.Heap.Layout

    import GHC.Cmm.Graph
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel

    import GHC.Types.CostCentre
    import GHC.Types.IPE
    import GHC.Types.ForeignStubs
    import GHC.Data.FastString
    import GHC.Unit.Module as Module
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Driver.CodeOutput ( ipInitCode )

    import GHC.Utils.Encoding

    import Control.Monad
    import Data.Char       (ord)
    import GHC.Utils.Monad (whenM)

    -----------------------------------------------------------------------------
    --
    -- Cost-centre-stack Profiling
    --
    -----------------------------------------------------------------------------

    -- Expression representing the current cost centre stack
    ccsType :: Platform -> CmmType -- Type of a cost-centre stack
    ccsType :: Platform -> CmmType
    ccsType = Platform -> CmmType
    bWord

    ccType :: Platform -> CmmType -- Type of a cost centre
    ccType :: Platform -> CmmType
    ccType = Platform -> CmmType
    bWord

    storeCurCCS :: Platform -> CmmExpr -> CmmAGraph
    storeCurCCS :: Platform -> CmmExpr -> CmmAGraph
    storeCurCCS Platform
    platform = CmmReg -> CmmExpr -> CmmAGraph
    mkAssign (Platform -> CmmReg
    cccsReg Platform
    platform)

    mkCCostCentre :: CostCentre -> CmmLit
    mkCCostCentre :: CostCentre -> CmmLit
    mkCCostCentre CostCentre
    cc = CLabel -> CmmLit
    CmmLabel (CostCentre -> CLabel
    mkCCLabel CostCentre
    cc)

    mkCCostCentreStack :: CostCentreStack -> CmmLit
    mkCCostCentreStack :: CostCentreStack -> CmmLit
    mkCCostCentreStack CostCentreStack
    ccs = CLabel -> CmmLit
    CmmLabel (CostCentreStack -> CLabel
    mkCCSLabel CostCentreStack
    ccs)

    costCentreFrom :: Platform
                   -> CmmExpr        -- A closure pointer
                   -> CmmExpr        -- The cost centre from that closure
    costCentreFrom :: Platform -> CmmExpr -> CmmExpr
    costCentreFrom Platform
    platform CmmExpr
    cl = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    cl (PlatformConstants -> Int
    pc_OFFSET_StgHeader_ccs (Platform -> PlatformConstants
    platformConstants Platform
    platform))) (Platform -> CmmType
    ccsType Platform
    platform) AlignmentSpec
    NaturallyAligned

    -- | The profiling header words in a static closure
    staticProfHdr :: Profile -> CostCentreStack -> [CmmLit]
    staticProfHdr :: Profile -> CostCentreStack -> [CmmLit]
    staticProfHdr Profile
    profile CostCentreStack
    ccs
      | Profile -> Bool
    profileIsProfiling Profile
    profile = [CostCentreStack -> CmmLit
    mkCCostCentreStack CostCentreStack
    ccs, Platform -> CmmLit
    staticProfHeaderInit Platform
    platform]
      | Bool
    otherwise                  = []
      where platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

    -- | Profiling header words in a dynamic closure
    dynProfHdr :: Profile -> CmmExpr -> [CmmExpr]
    dynProfHdr :: Profile -> CmmExpr -> [CmmExpr]
    dynProfHdr Profile
    profile CmmExpr
    ccs
      | Profile -> Bool
    profileIsProfiling Profile
    profile = [CmmExpr
    ccs, Platform -> CmmExpr
    dynProfInit (Profile -> Platform
    profilePlatform Profile
    profile)]
      | Bool
    otherwise                  = []

    -- | Initialise the profiling field of an update frame
    initUpdFrameProf :: CmmExpr -> FCode ()
    initUpdFrameProf :: CmmExpr -> FCode ()
    initUpdFrameProf CmmExpr
    frame
      = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $        -- frame->header.prof.ccs = CCCS
        do platform <- FCode Platform
    getPlatform
           emitStore (cmmOffset platform frame (pc_OFFSET_StgHeader_ccs (platformConstants platform))) (cccsExpr platform)
            -- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0)
            -- is unnecessary because it is not used anyhow.

    ---------------------------------------------------------------------------
    --         Saving and restoring the current cost centre
    ---------------------------------------------------------------------------

    {-        Note [Saving the current cost centre]
            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The current cost centre is like a global register.  Like other
    global registers, it's a caller-saves one.  But consider
            case (f x) of (p,q) -> rhs
    Since 'f' may set the cost centre, we must restore it
    before resuming rhs.  So we want code like this:
            local_cc = CCC  -- save
            r = f( x )
            CCC = local_cc  -- restore
    That is, we explicitly "save" the current cost centre in
    a LocalReg, local_cc; and restore it after the call. The
    C-- infrastructure will arrange to save local_cc across the
    call.

    The same goes for join points;
            let j x = join-stuff
            in blah-blah
    We want this kind of code:
            local_cc = CCC  -- save
            blah-blah
         J:
            CCC = local_cc  -- restore
    -}

    saveCurrentCostCentre :: FCode (Maybe LocalReg)
            -- Returns Nothing if profiling is off
    saveCurrentCostCentre :: FCode (Maybe LocalReg)
    saveCurrentCostCentre
      = do sccProfilingEnabled <- StgToCmmConfig -> Bool
    stgToCmmSCCProfiling (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode StgToCmmConfig
    getStgToCmmConfig
           platform            <- getPlatform
           if not sccProfilingEnabled
               then return Nothing
               else do local_cc <- newTemp (ccType platform)
                       emitAssign (CmmLocal local_cc) (cccsExpr platform)
                       return (Just local_cc)

    restoreCurrentCostCentre :: Platform -> Maybe LocalReg -> FCode ()
    restoreCurrentCostCentre :: Platform -> Maybe LocalReg -> FCode ()
    restoreCurrentCostCentre Platform
    _ Maybe LocalReg
    Nothing
      = () -> FCode ()
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    restoreCurrentCostCentre Platform
    platform (Just LocalReg
    local_cc)
      = CmmAGraph -> FCode ()
    emit (Platform -> CmmExpr -> CmmAGraph
    storeCurCCS Platform
    platform (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    local_cc)))

    -------------------------------------------------------------------------------
    -- Recording allocation in a cost centre
    -------------------------------------------------------------------------------

    -- | Record the allocation of a closure.  The CmmExpr is the cost
    -- centre stack to which to attribute the allocation.
    profDynAlloc :: SMRep -> CmmExpr -> FCode ()
    profDynAlloc :: SMRep -> CmmExpr -> FCode ()
    profDynAlloc SMRep
    rep CmmExpr
    ccs
      = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
        do profile <- FCode Profile
    getProfile
           let platform = Profile -> Platform
    profilePlatform Profile
    profile
           profAlloc (mkIntExpr platform (heapClosureSizeW profile rep)) ccs

    -- | Record the allocation of a closure (size is given by a CmmExpr)
    -- The size must be in words, because the allocation counter in a CCS counts
    -- in words.
    profAlloc :: CmmExpr -> CmmExpr -> FCode ()
    profAlloc :: CmmExpr -> CmmExpr -> FCode ()
    profAlloc CmmExpr
    words CmmExpr
    ccs
      = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
            do profile <- FCode Profile
    getProfile
               let platform = Profile -> Platform
    profilePlatform Profile
    profile
               let alloc_rep = Platform -> CmmType
    rEP_CostCentreStack_mem_alloc Platform
    platform
               emit $ addToMemE alloc_rep
                           (cmmOffsetB platform ccs (pc_OFFSET_CostCentreStack_mem_alloc (platformConstants platform)))
                           (CmmMachOp (MO_UU_Conv (wordWidth platform) (typeWidth alloc_rep))
                               -- subtract the "profiling overhead", which is the
                               -- profiling header in a closure.
                               [CmmMachOp (mo_wordSub platform) [ words, mkIntExpr platform (profHdrSize profile)]]
                           )

    -- -----------------------------------------------------------------------
    -- Setting the current cost centre on entry to a closure

    enterCostCentreThunk :: CmmExpr -> FCode ()
    enterCostCentreThunk :: CmmExpr -> FCode ()
    enterCostCentreThunk CmmExpr
    closure =
      FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
          platform <- FCode Platform
    getPlatform
          emit $ storeCurCCS platform (costCentreFrom platform closure)

    enterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()
    enterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()
    enterCostCentreFun CostCentreStack
    ccs CmmExpr
    closure = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
        Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CostCentreStack -> Bool
    isCurrentCCS CostCentreStack
    ccs) (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
        do platform <- FCode Platform
    getPlatform
           emitRtsCall
             rtsUnitId
             (fsLit "enterFunCCS")
             [(baseExpr platform, AddrHint), (costCentreFrom platform closure, AddrHint)]
             False
           -- otherwise we have a top-level function, nothing to do

    ifProfiling :: FCode () -> FCode ()
    ifProfiling :: FCode () -> FCode ()
    ifProfiling = FCode Bool -> FCode () -> FCode ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (StgToCmmConfig -> Bool
    stgToCmmSCCProfiling (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode StgToCmmConfig
    getStgToCmmConfig)

    ---------------------------------------------------------------
    --        Initialising Cost Centres & CCSs
    ---------------------------------------------------------------

    initCostCentres :: CollectedCCs -> FCode ()
    -- Emit the declarations
    initCostCentres :: CollectedCCs -> FCode ()
    initCostCentres ([CostCentre]
    local_CCs, [CostCentreStack]
    singleton_CCSs)
      = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
          (CostCentre -> FCode ()) -> [CostCentre] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CostCentre -> FCode ()
    emitCostCentreDecl [CostCentre]
    local_CCs
          (CostCentreStack -> FCode ()) -> [CostCentreStack] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ CostCentreStack -> FCode ()
    emitCostCentreStackDecl [CostCentreStack]
    singleton_CCSs

    emitCostCentreDecl :: CostCentre -> FCode ()
    emitCostCentreDecl :: CostCentre -> FCode ()
    emitCostCentreDecl CostCentre
    cc = do
      { ctx      <- StgToCmmConfig -> SDocContext
    stgToCmmContext (StgToCmmConfig -> SDocContext)
    -> FCode StgToCmmConfig -> FCode SDocContext
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode StgToCmmConfig
    getStgToCmmConfig
      ; platform <- getPlatform
      ; let is_caf | CostCentre -> Bool
    isCafCC CostCentre
    cc = Platform -> Int -> CmmLit
    mkIntCLit Platform
    platform (Char -> Int
    ord Char
    'c') -- 'c' == is a CAF
                   | Bool
    otherwise  = Platform -> CmmLit
    zero Platform
    platform
                            -- NB. bytesFS: we want the UTF-8 bytes here (#5559)
      ; label <- newByteStringCLit (bytesFS $ costCentreUserNameFS cc)
      ; modl  <- newByteStringCLit (bytesFS $ moduleNameFS
                                            $ moduleName
                                            $ cc_mod cc)
      ; loc <- newByteStringCLit $ utf8EncodeByteString $
                       renderWithContext ctx (ppr $! costCentreSrcSpan cc)
      ; let
         lits = [ Platform -> CmmLit
    zero Platform
    platform,  -- StgInt ccID,
                  CmmLit
    label,          -- char *label,
                  CmmLit
    modl,           -- char *module,
                  CmmLit
    loc,            -- char *srcloc,
                  CmmLit
    zero64,         -- StgWord64 mem_alloc
                  Platform -> CmmLit
    zero Platform
    platform,  -- StgWord time_ticks
                  CmmLit
    is_caf,         -- StgInt is_caf
                  Platform -> CmmLit
    zero Platform
    platform   -- struct _CostCentre *link
                ]
      ; emitDataLits (mkCCLabel cc) lits
      }

    emitCostCentreStackDecl :: CostCentreStack -> FCode ()
    emitCostCentreStackDecl :: CostCentreStack -> FCode ()
    emitCostCentreStackDecl CostCentreStack
    ccs
      = case CostCentreStack -> Maybe CostCentre
    maybeSingletonCCS CostCentreStack
    ccs of
        Just CostCentre
    cc ->
            do platform <- FCode Platform
    getPlatform
               let mk_lits CostCentre
    cc = Platform -> CmmLit
    zero Platform
    platform CmmLit -> [CmmLit] -> [CmmLit]
    forall a. a -> [a] -> [a]
    :
                                CostCentre -> CmmLit
    mkCCostCentre CostCentre
    cc CmmLit -> [CmmLit] -> [CmmLit]
    forall a. a -> [a] -> [a]
    :
                                Int -> CmmLit -> [CmmLit]
    forall a. Int -> a -> [a]
    replicate (Platform -> Int
    sizeof_ccs_words Platform
    platform Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) (Platform -> CmmLit
    zero Platform
    platform)
                    -- Note: to avoid making any assumptions about how the
                    -- C compiler (that compiles the RTS, in particular) does
                    -- layouts of structs containing long-longs, simply
                    -- pad out the struct with zero words until we hit the
                    -- size of the overall struct (which we get via DerivedConstants.h)
               emitDataLits (mkCCSLabel ccs) (mk_lits cc)
        Maybe CostCentre
    Nothing -> String -> SDoc -> FCode ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "emitCostCentreStackDecl" (CostCentreStack -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CostCentreStack
    ccs)

    zero :: Platform -> CmmLit
    zero :: Platform -> CmmLit
    zero Platform
    platform = Platform -> Int -> CmmLit
    mkIntCLit Platform
    platform Int
    0
    zero64 :: CmmLit
    zero64 :: CmmLit
    zero64 = Integer -> Width -> CmmLit
    CmmInt Integer
    0 Width
    W64

    sizeof_ccs_words :: Platform -> Int
    sizeof_ccs_words :: Platform -> Int
    sizeof_ccs_words Platform
    platform
        -- round up to the next word.
      | Int
    ms Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0   = Int
    ws
      | Bool
    otherwise = Int
    ws Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
      where
       (Int
    ws,Int
    ms) = PlatformConstants -> Int
    pc_SIZEOF_CostCentreStack (Platform -> PlatformConstants
    platformConstants Platform
    platform) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Platform -> Int
    platformWordSizeInBytes Platform
    platform

    -- | Emit info-table provenance declarations and track IPE stats.
    --
    -- Note that the stats passed to this function will (rather, should) only ever
    -- contain stats for skipped STACK info tables accumulated in
    -- 'generateCgIPEStub'.
    initInfoTableProv :: IPEStats -> [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub))
    initInfoTableProv :: IPEStats
    -> [CmmInfoTable]
    -> InfoTableProvMap
    -> FCode (Maybe (IPEStats, CStub))
    initInfoTableProv IPEStats
    stats [CmmInfoTable]
    infos InfoTableProvMap
    itmap
      = do
           cfg <- FCode StgToCmmConfig
    getStgToCmmConfig
           let (stats', ents) = convertInfoProvMap cfg this_mod itmap stats infos
               info_table    = StgToCmmConfig -> Bool
    stgToCmmInfoTableMap StgToCmmConfig
    cfg
               platform      = StgToCmmConfig -> Platform
    stgToCmmPlatform     StgToCmmConfig
    cfg
               this_mod      = StgToCmmConfig -> GenModule Unit
    stgToCmmThisModule   StgToCmmConfig
    cfg
           case ents of
             [] -> Maybe (IPEStats, CStub) -> FCode (Maybe (IPEStats, CStub))
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (IPEStats, CStub)
    forall a. Maybe a
    Nothing
             [InfoProvEnt]
    _  -> do
               -- Emit IPE buffer
               GenModule Unit -> [InfoProvEnt] -> FCode ()
    emitIpeBufferListNode GenModule Unit
    this_mod [InfoProvEnt]
    ents

               -- Create the C stub which initialises the IPE map
               Maybe (IPEStats, CStub) -> FCode (Maybe (IPEStats, CStub))
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((IPEStats, CStub) -> Maybe (IPEStats, CStub)
    forall a. a -> Maybe a
    Just (IPEStats
    stats', Bool -> Platform -> GenModule Unit -> CStub
    ipInitCode Bool
    info_table Platform
    platform GenModule Unit
    this_mod))

    -- ---------------------------------------------------------------------------
    -- Set the current cost centre stack

    emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
    emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
    emitSetCCC CostCentre
    cc Bool
    tick Bool
    push = FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
      do platform <- FCode Platform
    getPlatform
         tmp      <- newTemp (ccsType platform)
         pushCostCentre tmp (cccsExpr platform) cc
         when tick $ emit (bumpSccCount platform (CmmReg (CmmLocal tmp)))
         when push $ emit (storeCurCCS platform (CmmReg (CmmLocal tmp)))

    pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
    pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
    pushCostCentre LocalReg
    result CmmExpr
    ccs CostCentre
    cc
      = LocalReg
    -> ForeignHint
    -> UnitId
    -> FastString
    -> [(CmmExpr, ForeignHint)]
    -> Bool
    -> FCode ()
    emitRtsCallWithResult LocalReg
    result ForeignHint
    AddrHint
            UnitId
    rtsUnitId
            (String -> FastString
    fsLit String
    "pushCostCentre") [(CmmExpr
    ccs,ForeignHint
    AddrHint),
                                    (CmmLit -> CmmExpr
    CmmLit (CostCentre -> CmmLit
    mkCCostCentre CostCentre
    cc), ForeignHint
    AddrHint)]
            Bool
    False

    bumpSccCount :: Platform -> CmmExpr -> CmmAGraph
    bumpSccCount :: Platform -> CmmExpr -> CmmAGraph
    bumpSccCount Platform
    platform CmmExpr
    ccs
      = CmmType -> CmmExpr -> Int -> CmmAGraph
    addToMem (Platform -> CmmType
    rEP_CostCentreStack_scc_count Platform
    platform)
             (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    ccs (PlatformConstants -> Int
    pc_OFFSET_CostCentreStack_scc_count (Platform -> PlatformConstants
    platformConstants Platform
    platform))) Int
    1

    -----------------------------------------------------------------------------
    --
    --                Profiling header stuff
    --
    -----------------------------------------------------------------------------

    -- Header initialisation for static objects happens to coicincide for the
    -- three uses of the header
    --  * LDV profiling = 0 (era = 0, LDV_STATE_CREATE)
    --  * Eras profiling = 0 (user_era = 0, ignored by profiler)
    --  * Retainer profiling = 0

    staticProfHeaderInit :: Platform -> CmmLit
    staticProfHeaderInit :: Platform -> CmmLit
    staticProfHeaderInit Platform
    plat = Platform -> CmmLit
    zeroCLit Platform
    plat

    -- Dynamic initialisation

    dynErasInit :: Platform -> CmmExpr
    dynErasInit :: Platform -> CmmExpr
    dynErasInit Platform
    platform = Platform -> CmmExpr
    loadUserEra Platform
    platform

    dynLdvInit :: Platform -> CmmExpr
    dynLdvInit :: Platform -> CmmExpr
    dynLdvInit Platform
    platform =
    -- (era << LDV_SHIFT) | LDV_STATE_CREATE
      MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordOr Platform
    platform) [
          MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordShl Platform
    platform) [Platform -> CmmExpr
    loadEra Platform
    platform, Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (PlatformConstants -> Int
    pc_LDV_SHIFT (Platform -> PlatformConstants
    platformConstants Platform
    platform))],
          CmmLit -> CmmExpr
    CmmLit (Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (PlatformConstants -> Integer
    pc_ILDV_STATE_CREATE (Platform -> PlatformConstants
    platformConstants Platform
    platform)))
      ]

    -- | If LDV profiling the user_era = 0
    -- , if eras profiling then (ldv)era = 0, so we can initialise correctly by OR the two expressions.
    dynProfInit :: Platform -> CmmExpr
    dynProfInit :: Platform -> CmmExpr
    dynProfInit Platform
    platform = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordOr Platform
    platform) [(Platform -> CmmExpr
    dynLdvInit Platform
    platform), Platform -> CmmExpr
    dynErasInit Platform
    platform]

    -- |  Initialise the profiling word of a new dynamic closure
    -- * When LDV profiling is enabled (era > 0) - Initialise to the LDV word
    -- * When eras profiling is enabled (user_era > 0) - Initialise to current user_era
    profHeaderCreate :: CmmExpr -> FCode ()
    profHeaderCreate :: CmmExpr -> FCode ()
    profHeaderCreate CmmExpr
    closure = do
      platform <- FCode Platform
    getPlatform
      let prof_header_wd = Platform -> CmmExpr -> CmmExpr
    profHeaderWord Platform
    platform CmmExpr
    closure

      let check_ldv = CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThenElse (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUGt Platform
    platform) [Platform -> CmmExpr
    loadEra Platform
    platform, CmmLit -> CmmExpr
    CmmLit (Platform -> CmmLit
    zeroCLit Platform
    platform)])
      let check_eras = CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThenElse (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordUGt Platform
    platform) [Platform -> CmmExpr
    loadUserEra Platform
    platform, CmmLit -> CmmExpr
    CmmLit (Platform -> CmmLit
    zeroCLit Platform
    platform)])
      -- Case 2: user_era > 0, eras profiling is enabled
      check_1 <- check_eras (mkStore prof_header_wd (dynErasInit platform)) mkNop
      -- Case 1: era > 0, LDV profiling is enabled
      check_2 <- check_ldv (mkStore prof_header_wd (dynLdvInit platform)) check_1
      emit check_2

    --
    -- | Called when a closure is entered, marks the closure as having
    -- been "used".  The closure is not an "inherently used" one.  The
    -- closure is not @IND@ because that is not considered for LDV profiling.
    --
    ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
    ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
    ldvEnterClosure ClosureInfo
    closure_info CmmReg
    node_reg = do
        platform <- FCode Platform
    getPlatform
        let tag = Platform -> ClosureInfo -> Int
    funTag Platform
    platform ClosureInfo
    closure_info
        -- don't forget to subtract node's tag
        ldvEnter (cmmOffsetB platform (CmmReg node_reg) (-tag))

    ldvEnter :: CmmExpr -> FCode ()
    -- Argument is a closure pointer
    ldvEnter :: CmmExpr -> FCode ()
    ldvEnter CmmExpr
    cl_ptr = do
        platform <- FCode Platform
    getPlatform
        let constants = Platform -> PlatformConstants
    platformConstants Platform
    platform
            -- don't forget to subtract node's tag
            ldv_wd = Platform -> CmmExpr -> CmmExpr
    profHeaderWord Platform
    platform CmmExpr
    cl_ptr
            new_ldv_wd = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOrWord Platform
    platform
                            (Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmAndWord Platform
    platform (Platform -> CmmExpr -> CmmExpr
    cmmLoadBWord Platform
    platform CmmExpr
    ldv_wd)
                                                 (CmmLit -> CmmExpr
    CmmLit (Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (PlatformConstants -> Integer
    pc_ILDV_CREATE_MASK PlatformConstants
    constants))))
                            (Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOrWord Platform
    platform (Platform -> CmmExpr
    loadEra Platform
    platform) (CmmLit -> CmmExpr
    CmmLit (Platform -> Integer -> CmmLit
    mkWordCLit Platform
    platform (PlatformConstants -> Integer
    pc_ILDV_STATE_USE PlatformConstants
    constants))))
        ifProfiling $ do
           -- if (era > 0) {
             --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
             --                era | LDV_STATE_USE }
            emit =<< mkCmmIfThenElse (CmmMachOp (mo_wordUGt platform) [loadEra platform, CmmLit (zeroCLit platform)])
                         (mkStore ldv_wd new_ldv_wd)
                         mkNop

    loadEra :: Platform -> CmmExpr
    loadEra :: Platform -> CmmExpr
    loadEra Platform
    platform = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv (Platform -> Width
    cIntWidth Platform
    platform) (Platform -> Width
    wordWidth Platform
    platform))
        [CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (CLabel -> CmmExpr
    mkLblExpr (FastString -> CLabel
    mkRtsCmmDataLabel (String -> FastString
    fsLit String
    "era")))
                 (Platform -> CmmType
    cInt Platform
    platform)
                 AlignmentSpec
    NaturallyAligned]

    loadUserEra :: Platform -> CmmExpr
    loadUserEra :: Platform -> CmmExpr
    loadUserEra Platform
    platform = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (CLabel -> CmmExpr
    mkLblExpr (FastString -> CLabel
    mkRtsCmmDataLabel (String -> FastString
    fsLit String
    "user_era")))
                 (Platform -> CmmType
    bWord Platform
    platform)
                 AlignmentSpec
    NaturallyAligned

    -- | Takes the address of a closure, and returns
    -- the address of the prof header word in the closure (this is used to store LDV info,
    -- retainer profiling info and eras profiling info).
    profHeaderWord :: Platform -> CmmExpr -> CmmExpr
    profHeaderWord :: Platform -> CmmExpr -> CmmExpr
    profHeaderWord Platform
    platform CmmExpr
    closure_ptr
        = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    closure_ptr (PlatformConstants -> Int
    pc_OFFSET_StgHeader_ldvw (Platform -> PlatformConstants
    platformConstants Platform
    platform))