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

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

            -- infoTablePRov
            initInfoTableProv, emitInfoTableProv,

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

            saveCurrentCostCentre, restoreCurrentCostCentre,

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

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Ppr

    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Utils
    import GHC.StgToCmm.Monad
    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)

    -----------------------------------------------------------------------------
    --
    -- 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 :: CmmExpr -> CmmAGraph
    storeCurCCS :: CmmExpr -> CmmAGraph
    storeCurCCS CmmExpr
    e = CmmReg -> CmmExpr -> CmmAGraph
    mkAssign CmmReg
    cccsReg CmmExpr
    e

    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
    staticLdvInit 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
    dynLdvInit (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
    platform <- FCode Platform
    getPlatform
           CmmExpr -> CmmExpr -> FCode ()
    emitStore (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    frame (PlatformConstants -> Int
    pc_OFFSET_StgHeader_ccs (Platform -> PlatformConstants
    platformConstants Platform
    platform))) CmmExpr
    cccsExpr
            -- 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 DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           Platform
    platform <- FCode Platform
    getPlatform
           if Bool -> Bool
    not (DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags)
               then Maybe LocalReg -> FCode (Maybe LocalReg)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LocalReg
    forall a. Maybe a
    Nothing
               else do LocalReg
    local_cc <- CmmType -> FCode LocalReg
    forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
    newTemp (Platform -> CmmType
    ccType Platform
    platform)
                       CmmReg -> CmmExpr -> FCode ()
    emitAssign (LocalReg -> CmmReg
    CmmLocal LocalReg
    local_cc) CmmExpr
    cccsExpr
                       Maybe LocalReg -> FCode (Maybe LocalReg)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LocalReg -> Maybe LocalReg
    forall a. a -> Maybe a
    Just LocalReg
    local_cc)

    restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
    restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
    restoreCurrentCostCentre Maybe LocalReg
    Nothing
      = () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    restoreCurrentCostCentre (Just LocalReg
    local_cc)
      = CmmAGraph -> FCode ()
    emit (CmmExpr -> CmmAGraph
    storeCurCCS (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
    profile <- DynFlags -> Profile
    targetProfile (DynFlags -> Profile) -> FCode DynFlags -> FCode Profile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
           CmmExpr -> CmmExpr -> FCode ()
    profAlloc (Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (Profile -> SMRep -> Int
    heapClosureSizeW Profile
    profile SMRep
    rep)) CmmExpr
    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
    profile <- DynFlags -> Profile
    targetProfile (DynFlags -> Profile) -> FCode DynFlags -> FCode Profile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
               let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
               let alloc_rep :: CmmType
    alloc_rep = Platform -> CmmType
    rEP_CostCentreStack_mem_alloc Platform
    platform
               CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmType -> CmmExpr -> CmmExpr -> CmmAGraph
    addToMemE CmmType
    alloc_rep
                           (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform CmmExpr
    ccs (PlatformConstants -> Int
    pc_OFFSET_CostCentreStack_mem_alloc (Platform -> PlatformConstants
    platformConstants Platform
    platform)))
                           (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv (Platform -> Width
    wordWidth Platform
    platform) (CmmType -> Width
    typeWidth CmmType
    alloc_rep)) ([CmmExpr] -> CmmExpr) -> [CmmExpr] -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $
                               -- subtract the "profiling overhead", which is the
                               -- profiling header in a closure.
                               [MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordSub Platform
    platform) [ CmmExpr
    words, Platform -> Int -> CmmExpr
    mkIntExpr Platform
    platform (Profile -> Int
    profHdrSize Profile
    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
    platform <- FCode Platform
    getPlatform
          CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> CmmAGraph
    storeCurCCS (Platform -> CmmExpr -> CmmExpr
    costCentreFrom Platform
    platform CmmExpr
    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
    $
        if CostCentreStack -> Bool
    isCurrentCCS CostCentreStack
    ccs
           then do Platform
    platform <- FCode Platform
    getPlatform
                   UnitId
    -> FastString -> [(CmmExpr, ForeignHint)] -> Bool -> FCode ()
    emitRtsCall UnitId
    rtsUnitId (String -> FastString
    fsLit String
    "enterFunCCS")
                       [(CmmExpr
    baseExpr, ForeignHint
    AddrHint),
                        (Platform -> CmmExpr -> CmmExpr
    costCentreFrom Platform
    platform CmmExpr
    closure, ForeignHint
    AddrHint)] Bool
    False
           else () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- top-level function, nothing to do

    ifProfiling :: FCode () -> FCode ()
    ifProfiling :: FCode () -> FCode ()
    ifProfiling FCode ()
    code
      = do Profile
    profile <- DynFlags -> Profile
    targetProfile (DynFlags -> Profile) -> FCode DynFlags -> FCode Profile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           if Profile -> Bool
    profileIsProfiling Profile
    profile
               then FCode ()
    code
               else () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    ---------------------------------------------------------------
    --        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
      { DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      ; Platform
    platform <- FCode Platform
    getPlatform
      ; let is_caf :: CmmLit
    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)
      ; CmmLit
    label <- ByteString -> FCode CmmLit
    newByteStringCLit (FastString -> ByteString
    bytesFS (FastString -> ByteString) -> FastString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ CostCentre -> FastString
    costCentreUserNameFS CostCentre
    cc)
      ; CmmLit
    modl  <- ByteString -> FCode CmmLit
    newByteStringCLit (FastString -> ByteString
    bytesFS (FastString -> ByteString) -> FastString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> FastString
    moduleNameFS
                                            (ModuleName -> FastString) -> ModuleName -> FastString
    forall a b. (a -> b) -> a -> b
    $ GenModule Unit -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName
                                            (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ CostCentre -> GenModule Unit
    cc_mod CostCentre
    cc)
      ; CmmLit
    loc <- ByteString -> FCode CmmLit
    newByteStringCLit (ByteString -> FCode CmmLit) -> ByteString -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    utf8EncodeString (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                       DynFlags -> SrcSpan -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags (CostCentre -> SrcSpan
    costCentreSrcSpan CostCentre
    cc)
      ; let
         lits :: [CmmLit]
    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
                ]
      ; CLabel -> [CmmLit] -> FCode ()
    emitDataLits (CostCentre -> CLabel
    mkCCLabel CostCentre
    cc) [CmmLit]
    lits
      }

    emitCostCentreStackDecl :: CostCentreStack -> FCode ()
    emitCostCentreStackDecl :: CostCentreStack -> FCode ()
    emitCostCentreStackDecl CostCentreStack
    ccs
      = case CostCentreStack -> Maybe CostCentre
    maybeSingletonCCS CostCentreStack
    ccs of
        Just CostCentre
    cc ->
            do Platform
    platform <- FCode Platform
    getPlatform
               let mk_lits :: CostCentre -> [CmmLit]
    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)
               CLabel -> [CmmLit] -> FCode ()
    emitDataLits (CostCentreStack -> CLabel
    mkCCSLabel CostCentreStack
    ccs) (CostCentre -> [CmmLit]
    mk_lits CostCentre
    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

    initInfoTableProv ::  [CmmInfoTable] -> InfoTableProvMap -> Module -> FCode CStub
    -- Emit the declarations
    initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> GenModule Unit -> FCode CStub
    initInfoTableProv [CmmInfoTable]
    infos InfoTableProvMap
    itmap GenModule Unit
    this_mod
      = do
           DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           let ents :: [InfoProvEnt]
    ents = DynFlags
    -> [CmmInfoTable]
    -> GenModule Unit
    -> InfoTableProvMap
    -> [InfoProvEnt]
    convertInfoProvMap DynFlags
    dflags [CmmInfoTable]
    infos GenModule Unit
    this_mod InfoTableProvMap
    itmap
           --pprTraceM "UsedInfo" (ppr (length infos))
           --pprTraceM "initInfoTable" (ppr (length ents))
           -- Output the actual IPE data
           (InfoProvEnt -> FCode ()) -> [InfoProvEnt] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ InfoProvEnt -> FCode ()
    emitInfoTableProv [InfoProvEnt]
    ents
           -- Create the C stub which initialises the IPE_LIST
           CStub -> FCode CStub
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynFlags -> GenModule Unit -> [InfoProvEnt] -> CStub
    ipInitCode DynFlags
    dflags GenModule Unit
    this_mod [InfoProvEnt]
    ents)

    --- Info Table Prov stuff
    emitInfoTableProv :: InfoProvEnt  -> FCode ()
    emitInfoTableProv :: InfoProvEnt -> FCode ()
    emitInfoTableProv InfoProvEnt
    ip = do
      { DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      ; let mod :: GenModule Unit
    mod = InfoProvEnt -> GenModule Unit
    infoProvModule InfoProvEnt
    ip
      ; let (String
    src, String
    label) = (String, String)
    -> ((RealSrcSpan, String) -> (String, String))
    -> Maybe (RealSrcSpan, String)
    -> (String, String)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String
    "", String
    "") (\(RealSrcSpan
    s, String
    l) -> (DynFlags -> RealSrcSpan -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags RealSrcSpan
    s, String
    l)) (InfoProvEnt -> Maybe (RealSrcSpan, String)
    infoTableProv InfoProvEnt
    ip)
      ; Platform
    platform <- FCode Platform
    getPlatform
      ; let mk_string :: String -> FCode CmmLit
    mk_string = ByteString -> FCode CmmLit
    newByteStringCLit (ByteString -> FCode CmmLit)
    -> (String -> ByteString) -> String -> FCode CmmLit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    utf8EncodeString
      ; CmmLit
    label <- String -> FCode CmmLit
    mk_string String
    label
      ; CmmLit
    modl  <- ByteString -> FCode CmmLit
    newByteStringCLit (FastString -> ByteString
    bytesFS (FastString -> ByteString) -> FastString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> FastString
    moduleNameFS
                                            (ModuleName -> FastString) -> ModuleName -> FastString
    forall a b. (a -> b) -> a -> b
    $ GenModule Unit -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName
                                            (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ GenModule Unit
    mod)

      ; CmmLit
    ty_string  <- String -> FCode CmmLit
    mk_string (InfoProvEnt -> String
    infoTableType InfoProvEnt
    ip)
      ; CmmLit
    loc <- String -> FCode CmmLit
    mk_string String
    src
      ; CmmLit
    table_name <- String -> FCode CmmLit
    mk_string (DynFlags -> SDoc -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags (Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle (InfoProvEnt -> CLabel
    infoTablePtr InfoProvEnt
    ip)))
      ; CmmLit
    closure_type <- String -> FCode CmmLit
    mk_string
                          (DynFlags -> SDoc -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags (String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ InfoProvEnt -> Int
    infoProvEntClosureType InfoProvEnt
    ip))
      ; let
         lits :: [CmmLit]
    lits = [ CLabel -> CmmLit
    CmmLabel (InfoProvEnt -> CLabel
    infoTablePtr InfoProvEnt
    ip), -- Info table pointer
                  CmmLit
    table_name,     -- char *table_name
                  CmmLit
    closure_type,   -- char *closure_desc -- Filled in from the InfoTable
                  CmmLit
    ty_string,      -- char *ty_string
                  CmmLit
    label,          -- char *label,
                  CmmLit
    modl,           -- char *module,
                  CmmLit
    loc,            -- char *srcloc,
                  Platform -> CmmLit
    zero Platform
    platform   -- struct _InfoProvEnt *link
                ]
      ; CLabel -> [CmmLit] -> FCode ()
    emitDataLits (InfoProvEnt -> CLabel
    mkIPELabel InfoProvEnt
    ip) [CmmLit]
    lits
      }
    -- ---------------------------------------------------------------------------
    -- Set the current cost centre stack

    emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
    emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
    emitSetCCC CostCentre
    cc Bool
    tick Bool
    push
     = do Profile
    profile <- DynFlags -> Profile
    targetProfile (DynFlags -> Profile) -> FCode DynFlags -> FCode Profile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
          if Bool -> Bool
    not (Profile -> Bool
    profileIsProfiling Profile
    profile)
              then () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              else do LocalReg
    tmp <- CmmType -> FCode LocalReg
    forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
    newTemp (Platform -> CmmType
    ccsType Platform
    platform)
                      LocalReg -> CmmExpr -> CostCentre -> FCode ()
    pushCostCentre LocalReg
    tmp CmmExpr
    cccsExpr CostCentre
    cc
                      Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    tick (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmAGraph -> FCode ()
    emit (Platform -> CmmExpr -> CmmAGraph
    bumpSccCount Platform
    platform (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    tmp)))
                      Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    push (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmAGraph -> FCode ()
    emit (CmmExpr -> CmmAGraph
    storeCurCCS (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    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

    -----------------------------------------------------------------------------
    --
    --                Lag/drag/void stuff
    --
    -----------------------------------------------------------------------------

    --
    -- Initial value for the LDV field in a static closure
    --
    staticLdvInit :: Platform -> CmmLit
    staticLdvInit :: Platform -> CmmLit
    staticLdvInit = Platform -> CmmLit
    zeroCLit

    --
    -- Initial value of the LDV field in a dynamic closure
    --
    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)))
      ]

    --
    -- Initialise the LDV word of a new closure
    --
    ldvRecordCreate :: CmmExpr -> FCode ()
    ldvRecordCreate :: CmmExpr -> FCode ()
    ldvRecordCreate CmmExpr
    closure = do
      Platform
    platform <- FCode Platform
    getPlatform
      CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> CmmExpr -> CmmAGraph
    mkStore (Platform -> CmmExpr -> CmmExpr
    ldvWord Platform
    platform CmmExpr
    closure) (Platform -> CmmExpr
    dynLdvInit Platform
    platform)

    --
    -- | 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
    platform <- FCode Platform
    getPlatform
        let tag :: Int
    tag = Platform -> ClosureInfo -> Int
    funTag Platform
    platform ClosureInfo
    closure_info
        -- don't forget to subtract node's tag
        CmmExpr -> FCode ()
    ldvEnter (Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffsetB Platform
    platform (CmmReg -> CmmExpr
    CmmReg CmmReg
    node_reg) (-Int
    tag))

    ldvEnter :: CmmExpr -> FCode ()
    -- Argument is a closure pointer
    ldvEnter :: CmmExpr -> FCode ()
    ldvEnter CmmExpr
    cl_ptr = do
        Platform
    platform <- FCode Platform
    getPlatform
        let constants :: PlatformConstants
    constants = Platform -> PlatformConstants
    platformConstants Platform
    platform
            -- don't forget to subtract node's tag
            ldv_wd :: CmmExpr
    ldv_wd = Platform -> CmmExpr -> CmmExpr
    ldvWord Platform
    platform CmmExpr
    cl_ptr
            new_ldv_wd :: CmmExpr
    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))))
        FCode () -> FCode ()
    ifProfiling (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
             -- if (era > 0) {
             --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
             --                era | LDV_STATE_USE }
            CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< 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)])
                         (CmmExpr -> CmmExpr -> CmmAGraph
    mkStore CmmExpr
    ldv_wd CmmExpr
    new_ldv_wd)
                         CmmAGraph
    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]

    -- | Takes the address of a closure, and returns
    -- the address of the LDV word in the closure
    ldvWord :: Platform -> CmmExpr -> CmmExpr
    ldvWord :: Platform -> CmmExpr -> CmmExpr
    ldvWord 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))