    {-# LANGUAGE MultiWayIf #-}

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

    {- OVERVIEW: ticky ticky profiling

    Please see
    https://gitlab.haskell.org/ghc/ghc/wikis/debugging/ticky-ticky and also
    edit it and the rest of this comment to keep them up-to-date if you
    change ticky-ticky. Thanks!

     *** All allocation ticky numbers are in bytes. ***

    Some of the relevant source files:

           ***not necessarily an exhaustive list***

      * some codeGen/ modules import this one

      * this module imports GHC.Cmm.CLabel to manage labels

      * GHC.Cmm.Parser expands some macros using generators defined in
        this module

      * rts/include/stg/Ticky.h declares all of the global counters

      * rts/include/rts/Ticky.h declares the C data type for an
        STG-declaration's counters

      * some macros defined in rts/include/Cmm.h (and used within the RTS's
        CMM code) update the global ticky counters

      * at the end of execution rts/Ticky.c generates the final report
        +RTS -r<report-file> -RTS

    The rts/Ticky.c function that generates the report includes an
    STG-declaration's ticky counters if

      * that declaration was entered, or

      * it was allocated (if -ticky-allocd)

    On either of those events, the counter is "registered" by adding it to
    a linked list; cf the CMM generated by registerTickyCtr.

    Ticky-ticky profiling has evolved over many years. Many of the
    counters from its most sophisticated days are no longer
    active/accurate. As the RTS has changed, sometimes the ticky code for
    relevant counters was not accordingly updated. Unfortunately, neither
    were the comments.

    As of March 2013, there still exist deprecated code and comments in
    the code generator as well as the RTS because:

      * I don't know what is out-of-date versus merely commented out for
        momentary convenience, and

      * someone else might know how to repair it!

    Note [Ticky counters are static]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Currently GHC only supports static ticky events. That is -ticky emits
    code containing labels containing counters which then get bumped at runtime.

    There are currently only *static* ticky counters. Either we bump one of the
    static counters included in the RTS. Or we emit StgEntCounter structures in
    the object code and bump these.
    -}

    module GHC.StgToCmm.Ticky (
      withNewTickyCounterFun,
      withNewTickyCounterLNE,
      withNewTickyCounterThunk,
      withNewTickyCounterStdThunk,
      withNewTickyCounterCon,
      emitTickyCounterTag,

      tickyDynAlloc,
      tickyAllocHeap,

      tickyAllocPrim,
      tickyAllocThunk,
      tickyAllocPAP,
      tickyHeapCheck,
      tickyStackCheck,

      tickyDirectCall,

      tickyPushUpdateFrame,
      tickyUpdateFrameOmitted,

      tickyEnterDynCon,

      tickyEnterFun,
      tickyEnterThunk,
      tickyEnterLNE,

      tickyUpdateBhCaf,
      tickyUnboxedTupleReturn,
      tickyReturnOldCon, tickyReturnNewCon,

      tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
      tickySlowCall, tickySlowCallPat,

      tickyTagged, tickyUntagged, tickyTagSkip
      ) where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Profile

    import GHC.StgToCmm.ArgRep    ( slowCallPattern, toArgRepOrV, argRepString )
    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Config
    import {-# SOURCE #-} GHC.StgToCmm.Foreign   ( emitPrimCall )
    import GHC.StgToCmm.Lit       ( newStringCLit )
    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Utils

    import GHC.Stg.Syntax
    import GHC.Cmm.Expr
    import GHC.Cmm.Graph
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel
    import GHC.Runtime.Heap.Layout

    import GHC.Types.Name
    import GHC.Types.Id
    import GHC.Types.Basic
    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Monad (whenM)

    -- Turgid imports for showTypeCategory
    import GHC.Builtin.Names
    import GHC.Tc.Utils.TcType
    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Core.Predicate

    import Data.Maybe
    import qualified Data.Char
    import Control.Monad ( when, unless )
    import GHC.Types.Id.Info
    import GHC.StgToCmm.Env (getCgInfo_maybe)
    import Data.Coerce (coerce)
    import GHC.Utils.Json
    import GHC.Utils.Unique (anyOfUnique)

    -----------------------------------------------------------------------------
    --
    -- Ticky-ticky profiling
    --
    -----------------------------------------------------------------------------

    -- | Number of arguments for a ticky counter.
    --
    -- Ticky currently treats args to constructor allocations differently than those for functions/LNE bindings.
    tickyArgArity :: TickyClosureType -> Int
    tickyArgArity :: TickyClosureType -> Int
    tickyArgArity (TickyFun Bool
    _ [NonVoid Id]
    _fvs [NonVoid Id]
    args) = [NonVoid Id] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [NonVoid Id]
    args
    tickyArgArity (TickyLNE [NonVoid Id]
    args) = [NonVoid Id] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [NonVoid Id]
    args
    tickyArgArity (TickyCon{}) = Int
    0
    tickyArgArity (TickyThunk{}) = Int
    0

    tickyArgDesc :: TickyClosureType -> String
    tickyArgDesc :: TickyClosureType -> String
    tickyArgDesc TickyClosureType
    arg_info =
      case TickyClosureType
    arg_info of
        TickyFun Bool
    _ [NonVoid Id]
    _fvs [NonVoid Id]
    args -> (NonVoid Id -> Char) -> [NonVoid Id] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Char
    showTypeCategory (Type -> Char) -> (NonVoid Id -> Type) -> NonVoid Id -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType (Id -> Type) -> (NonVoid Id -> Id) -> NonVoid Id -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid) [NonVoid Id]
    args
        TickyLNE [NonVoid Id]
    args -> (NonVoid Id -> Char) -> [NonVoid Id] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Char
    showTypeCategory (Type -> Char) -> (NonVoid Id -> Type) -> NonVoid Id -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType (Id -> Type) -> (NonVoid Id -> Id) -> NonVoid Id -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid) [NonVoid Id]
    args
        TickyThunk{} -> String
    ""
        TickyCon{} -> String
    ""

    tickyFvDesc :: TickyClosureType -> String
    tickyFvDesc :: TickyClosureType -> String
    tickyFvDesc TickyClosureType
    arg_info =
      case TickyClosureType
    arg_info of
        TickyFun Bool
    _ [NonVoid Id]
    fvs [NonVoid Id]
    _args -> (NonVoid Id -> Char) -> [NonVoid Id] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Char
    showTypeCategory (Type -> Char) -> (NonVoid Id -> Type) -> NonVoid Id -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType (Id -> Type) -> (NonVoid Id -> Id) -> NonVoid Id -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid) [NonVoid Id]
    fvs
        TickyLNE{} -> String
    ""
        TickyThunk Bool
    _ Bool
    _ [StgArg]
    fvs -> (StgArg -> Char) -> [StgArg] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Char
    showTypeCategory (Type -> Char) -> (StgArg -> Type) -> StgArg -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> Type
    stgArgType) [StgArg]
    fvs
        TickyCon{} -> String
    ""

    instance ToJson TickyClosureType where
        json :: TickyClosureType -> JsonDoc
    json TickyClosureType
    info = case TickyClosureType
    info of
          (TickyFun {})   -> String -> String -> String -> JsonDoc
    mkInfo (TickyClosureType -> String
    tickyFvDesc TickyClosureType
    info) (TickyClosureType -> String
    tickyArgDesc TickyClosureType
    info) String
    "fun"
          (TickyLNE {})   -> String -> String -> String -> JsonDoc
    mkInfo []                 (TickyClosureType -> String
    tickyArgDesc TickyClosureType
    info) String
    "lne"
          (TickyThunk Bool
    uf Bool
    _ [StgArg]
    _) -> String -> String -> String -> JsonDoc
    mkInfo (TickyClosureType -> String
    tickyFvDesc TickyClosureType
    info) []              (String
    "thk" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    uf then String
    "_u" else String
    "")
          (TickyCon{})    -> String -> String -> String -> JsonDoc
    mkInfo []                 []                  String
    "con"
          where
            mkInfo :: String -> String -> String -> JsonDoc
            mkInfo :: String -> String -> String -> JsonDoc
    mkInfo String
    fvs String
    args String
    ty =
              [(String, JsonDoc)] -> JsonDoc
    JSObject
                  [(String
    "type", String -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json String
    "entCntr")
                  ,(String
    "subTy", String -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json String
    ty)
                  ,(String
    "fvs_c", Int -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    fvs))
                  ,(String
    "fvs" , String -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json String
    fvs)
                  ,(String
    "args", String -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json String
    args)
                  ]

    tickyEntryDescJson :: (SDocContext -> TickyClosureType -> String)
    tickyEntryDescJson :: SDocContext -> TickyClosureType -> String
    tickyEntryDescJson SDocContext
    ctxt = SDocContext -> SDoc -> String
    renderWithContext SDocContext
    ctxt (SDoc -> String)
    -> (TickyClosureType -> SDoc) -> TickyClosureType -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JsonDoc -> SDoc
    renderJSON (JsonDoc -> SDoc)
    -> (TickyClosureType -> JsonDoc) -> TickyClosureType -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TickyClosureType -> JsonDoc
    forall a. ToJson a => a -> JsonDoc
    json

    data TickyClosureType
        = TickyFun
            Bool -- True <-> single entry
            [NonVoid Id] -- ^ FVs
            [NonVoid Id] -- ^ Args
        | TickyCon
            DataCon -- the allocated constructor
            ConstructorNumber
        | TickyThunk
            Bool -- True <-> updateable
            Bool -- True <-> standard thunk (AP or selector), has no entry counter
            [StgArg] -- ^ FVS, StgArg because for thunks these can also be literals.
        | TickyLNE
            [NonVoid Id] -- ^ Args

    withNewTickyCounterFun :: Bool -> Id -> [NonVoid Id] -> [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterFun :: forall a.
    Bool -> Id -> [NonVoid Id] -> [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterFun Bool
    single_entry Id
    f [NonVoid Id]
    fvs [NonVoid Id]
    args = TickyClosureType -> Id -> FCode a -> FCode a
    forall a. TickyClosureType -> Id -> FCode a -> FCode a
    withNewTickyCounter (Bool -> [NonVoid Id] -> [NonVoid Id] -> TickyClosureType
    TickyFun Bool
    single_entry [NonVoid Id]
    fvs [NonVoid Id]
    args) Id
    f

    withNewTickyCounterLNE :: Id  ->  [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterLNE :: forall a. Id -> [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterLNE Id
    nm [NonVoid Id]
    args FCode a
    code = do
      b <- (StgToCmmConfig -> Bool) -> FCode Bool
    isEnabled StgToCmmConfig -> Bool
    stgToCmmTickyLNE
      if not b then code else withNewTickyCounter (TickyLNE args) nm code

    thunkHasCounter :: Bool -> FCode Bool
    thunkHasCounter :: Bool -> FCode Bool
    thunkHasCounter Bool
    isStatic = (Bool -> Bool
    not Bool
    isStatic Bool -> Bool -> Bool
    &&) (Bool -> Bool) -> FCode Bool -> FCode Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgToCmmConfig -> Bool) -> FCode Bool
    isEnabled StgToCmmConfig -> Bool
    stgToCmmTickyDynThunk

    withNewTickyCounterThunk
      :: Bool -- ^ static
      -> Bool -- ^ updateable
      -> Id
      -> [NonVoid Id] -- ^ Free vars
      -> FCode a
      -> FCode a
    withNewTickyCounterThunk :: forall a. Bool -> Bool -> Id -> [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterThunk Bool
    isStatic Bool
    isUpdatable Id
    name [NonVoid Id]
    fvs FCode a
    code = do
        has_ctr <- Bool -> FCode Bool
    thunkHasCounter Bool
    isStatic
        if not has_ctr
          then code
          else withNewTickyCounter (TickyThunk isUpdatable False (map StgVarArg $ coerce fvs)) name code

    withNewTickyCounterStdThunk
      :: Bool -- ^ updateable
      -> Id
      -> [StgArg] -- ^ Free vars + function
      -> FCode a
      -> FCode a
    withNewTickyCounterStdThunk :: forall a. Bool -> Id -> [StgArg] -> FCode a -> FCode a
    withNewTickyCounterStdThunk Bool
    isUpdatable Id
    name [StgArg]
    fvs FCode a
    code = do
        has_ctr <- Bool -> FCode Bool
    thunkHasCounter Bool
    False
        if not has_ctr
          then code
          else withNewTickyCounter (TickyThunk isUpdatable True fvs) name code

    withNewTickyCounterCon
      :: Id
      -> DataCon
      -> ConstructorNumber
      -> FCode a
      -> FCode a
    withNewTickyCounterCon :: forall a. Id -> DataCon -> ConstructorNumber -> FCode a -> FCode a
    withNewTickyCounterCon Id
    name DataCon
    datacon ConstructorNumber
    info FCode a
    code = do
        has_ctr <- Bool -> FCode Bool
    thunkHasCounter Bool
    False
        if not has_ctr
          then code
          else withNewTickyCounter (TickyCon datacon info) name code

    -- args does not include the void arguments
    withNewTickyCounter :: TickyClosureType -> Id -> FCode a -> FCode a
    withNewTickyCounter :: forall a. TickyClosureType -> Id -> FCode a -> FCode a
    withNewTickyCounter TickyClosureType
    cloType Id
    name FCode a
    m = do
      lbl <- TickyClosureType -> Id -> FCode CLabel
    emitTickyCounter TickyClosureType
    cloType Id
    name
      setTickyCtrLabel lbl m

    emitTickyData :: Platform
                  -> CLabel -- ^ lbl for the counter
                  -> Arity -- ^ arity
                  -> CmmLit -- ^ fun desc
                  -> CmmLit -- ^ arg desc
                  -> CmmLit -- ^ json desc
                  -> CmmLit -- ^ info table lbl
                  -> FCode ()
    emitTickyData :: Platform
    -> CLabel
    -> Int
    -> CmmLit
    -> CmmLit
    -> CmmLit
    -> CmmLit
    -> FCode ()
    emitTickyData Platform
    platform CLabel
    ctr_lbl Int
    arity CmmLit
    fun_desc CmmLit
    arg_desc CmmLit
    json_desc CmmLit
    info_tbl =
      CLabel -> [CmmLit] -> FCode ()
    emitDataLits CLabel
    ctr_lbl
        -- Must match layout of rts/include/rts/Ticky.h's StgEntCounter
        --
        -- krc: note that all the fields are I32 now; some were I16
        -- before, but the code generator wasn't handling that
        -- properly and it led to chaos, panic and disorder.
            [ Platform -> CmmLit
    zeroCLit Platform
    platform,               -- registered?
              Platform -> Int -> CmmLit
    mkIntCLit Platform
    platform Int
    arity,   -- Arity
              Platform -> CmmLit
    zeroCLit Platform
    platform,               -- Heap allocated for this thing
              CmmLit
    fun_desc,
              CmmLit
    arg_desc,
              CmmLit
    json_desc,
              CmmLit
    info_tbl,
              Platform -> CmmLit
    zeroCLit Platform
    platform,          -- Entries into this thing
              Platform -> CmmLit
    zeroCLit Platform
    platform,          -- Heap allocated by this thing
              Platform -> CmmLit
    zeroCLit Platform
    platform           -- Link to next StgEntCounter
            ]

    emitTickyCounter :: TickyClosureType -> Id -> FCode CLabel
    emitTickyCounter :: TickyClosureType -> Id -> FCode CLabel
    emitTickyCounter TickyClosureType
    cloType Id
    tickee
      = let name :: Name
    name = Id -> Name
    idName Id
    tickee in
        let ctr_lbl :: CLabel
    ctr_lbl = Name -> CLabel
    mkRednCountsLabel Name
    name in
        (FCode () -> FCode CLabel -> FCode CLabel
    forall a b. FCode a -> FCode b -> FCode b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CLabel -> FCode CLabel
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CLabel
    ctr_lbl) (FCode () -> FCode CLabel) -> FCode () -> FCode CLabel
    forall a b. (a -> b) -> a -> b
    $
        FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
            { cfg    <- FCode StgToCmmConfig
    getStgToCmmConfig
            ; parent <- getTickyCtrLabel
            ; mod_name <- getModuleName

              -- When printing the name of a thing in a ticky file, we
              -- want to give the module name even for *local* things.  We
              -- print just "x (M)" rather that "M.x" to distinguish them
              -- from the global kind by calling to @pprTickyName@
            ; let platform = StgToCmmConfig -> Platform
    stgToCmmPlatform StgToCmmConfig
    cfg
                  ppr_for_ticky_name :: SDoc
                  ppr_for_ticky_name =
                    let ext :: SDoc
    ext = case TickyClosureType
    cloType of
                                  TickyFun Bool
    single_entry [NonVoid Id]
    _ [NonVoid Id]
    _-> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
                                      [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "fun"] [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "se"|Bool
    single_entry]
                                  TickyCon DataCon
    datacon ConstructorNumber
    _cn -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "con:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DataCon -> Name
    dataConName DataCon
    datacon))
                                  TickyThunk Bool
    upd Bool
    std [StgArg]
    _-> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
                                      [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "thk"] [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "se"|Bool -> Bool
    not Bool
    upd] [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "std"|Bool
    std]
                                  TickyLNE [NonVoid Id]
    _ | Name -> Bool
    isInternalName Name
    name -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "LNE")
                                             | Bool
    otherwise -> String -> SDoc
    forall a. HasCallStack => String -> a
    panic String
    "emitTickyCounter: how is this an external LNE?"
                        p :: SDoc
    p = case CLabel -> Maybe Name
    hasHaskellName CLabel
    parent of
                                -- NB the default "top" ticky ctr does not
                                -- have a Haskell name
                              Just Name
    pname -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> Unique
    nameUnique Name
    pname)
                              Maybe Name
    _ -> SDoc
    forall doc. IsOutput doc => doc
    empty
                    in Module -> Name -> SDoc
    pprTickyName Module
    mod_name Name
    name SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    ext SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    p
            ; this_mod <- getModuleName
            ; let t = case TickyClosureType
    cloType of
                        TickyCon {} -> String
    "C"
                        TickyFun {} -> String
    "F"
                        TickyThunk {} -> String
    "T"
                        TickyLNE {} -> String
    "L"
            ; info_lbl <- case cloType of
                                TickyCon DataCon
    dc ConstructorNumber
    mn -> case ConstructorNumber
    mn of
                                                   ConstructorNumber
    NoNumber -> CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! CLabel -> CmmLit
    CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
    forall a b. (a -> b) -> a -> b
    $ Name -> ConInfoTableLocation -> CLabel
    mkConInfoTableLabel (DataCon -> Name
    dataConName DataCon
    dc) ConInfoTableLocation
    DefinitionSite
                                                   (Numbered Int
    n) -> CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! CLabel -> CmmLit
    CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
    forall a b. (a -> b) -> a -> b
    $ Name -> ConInfoTableLocation -> CLabel
    mkConInfoTableLabel (DataCon -> Name
    dataConName DataCon
    dc) (Module -> Int -> ConInfoTableLocation
    UsageSite Module
    this_mod Int
    n)
                                TickyFun {} ->
                                  CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! CLabel -> CmmLit
    CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
    forall a b. (a -> b) -> a -> b
    $ Name -> CafInfo -> CLabel
    mkInfoTableLabel Name
    name CafInfo
    NoCafRefs

                                TickyThunk Bool
    _ Bool
    std_thunk [StgArg]
    _fvs
                                  | Bool -> Bool
    not Bool
    std_thunk
                                  -> CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! CLabel -> CmmLit
    CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
    forall a b. (a -> b) -> a -> b
    $ Name -> CafInfo -> CLabel
    mkInfoTableLabel Name
    name CafInfo
    NoCafRefs
                                  -- IPE Maps have no entry for std thunks.
                                  | Bool
    otherwise
                                  -> do
                                        lf_info <- Name -> FCode (Maybe CgIdInfo)
    getCgInfo_maybe Name
    name
                                        profile <- getProfile
                                        case lf_info of
                                          Just (CgIdInfo { cg_lf :: CgIdInfo -> LambdaFormInfo
    cg_lf = LambdaFormInfo
    cg_lf })
                                              | LambdaFormInfo -> Bool
    isLFThunk LambdaFormInfo
    cg_lf
                                              -> CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! CLabel -> CmmLit
    CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
    forall a b. (a -> b) -> a -> b
    $ Platform -> Id -> LambdaFormInfo -> CLabel
    mkClosureInfoTableLabel (Profile -> Platform
    profilePlatform Profile
    profile) Id
    tickee LambdaFormInfo
    cg_lf
                                          Maybe CgIdInfo
    _   -> String
    -> SDoc -> (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a. String -> SDoc -> a -> a
    pprTraceDebug String
    "tickyThunkUnknown" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    t SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CLabel -> SDoc
    pprDebugCLabel (Profile -> Platform
    profilePlatform Profile
    profile) (Name -> CafInfo -> CLabel
    mkInfoTableLabel Name
    name CafInfo
    NoCafRefs))
                                                CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! Platform -> CmmLit
    zeroCLit Platform
    platform

                                TickyLNE {} -> CmmLit -> FCode CmmLit
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmLit -> FCode CmmLit) -> CmmLit -> FCode CmmLit
    forall a b. (a -> b) -> a -> b
    $! Platform -> CmmLit
    zeroCLit Platform
    platform

            ; let ctx = SDocContext
    defaultSDocContext {sdocPprDebug = True}
            ; fun_descr_lit <- newStringCLit $ renderWithContext ctx ppr_for_ticky_name
            ; arg_descr_lit <- newStringCLit $ tickyArgDesc cloType
            ; json_descr_lit <- newStringCLit $ tickyEntryDescJson ctx cloType
            ; emitTickyData platform ctr_lbl (tickyArgArity cloType) fun_descr_lit arg_descr_lit json_descr_lit info_lbl
            }

    {- Note [TagSkip ticky counters]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    These counters keep track how often we execute code where we
    would have performed a tag check if we hadn't run tag inference.

    If we have some code of the form:
        case v[tagged] of ...
    and we want to record how often we avoid a tag check on v
    through tag inference we have to emit a new StgEntCounter for
    each such case statement in order to record how often it's executed.

    In theory we could emit one per *binding*. But then we
    would have to either keep track of the bindings which
    already have a StgEntCounter associated with them in the
    code gen state or preallocate such a structure for each binding
    in the code unconditionally (since ticky-code can call non-ticky code)

    The first makes the compiler slower, even when ticky is not
    used (a big no no). The later is fairly complex but increases code size
    unconditionally. See also Note [Ticky counters are static].

    So instead we emit a new StgEntCounter for each use site of a binding
    where we infered a tag to be present. And increment the counter whenever
    this use site is executed.

    We use the fields as follows:

    entry_count: Entries avoided.
    str:       : Name of the id.

    We use emitTickyCounterTag to emit the counter.

    Unlike the closure counters each *use* site of v has it's own
    counter. So there is no need to keep track of the closure/case we are
    in.

    We also have to pass a unique for the counter. An Id might be
    scrutinized in more than one place, so the ID alone isn't enough
    to distinguish between use sites.
    -}

    emitTickyCounterTag :: Unique -> NonVoid Id -> FCode CLabel
    emitTickyCounterTag :: Unique -> NonVoid Id -> FCode CLabel
    emitTickyCounterTag Unique
    unique (NonVoid Id
    id) =
      let name :: Name
    name = Id -> Name
    idName Id
    id
          ctr_lbl :: CLabel
    ctr_lbl = Name -> Unique -> CLabel
    mkTagHitLabel Name
    name Unique
    unique in
        (FCode () -> FCode CLabel -> FCode CLabel
    forall a b. FCode a -> FCode b -> FCode b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CLabel -> FCode CLabel
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CLabel
    ctr_lbl) (FCode () -> FCode CLabel) -> FCode () -> FCode CLabel
    forall a b. (a -> b) -> a -> b
    $
        FCode () -> FCode ()
    ifTickyTag (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
            { platform <- FCode Platform
    getPlatform
            ; parent <- getTickyCtrLabel
            ; mod_name <- getModuleName

              -- When printing the name of a thing in a ticky file, we
              -- want to give the module name even for *local* things.  We
              -- print just "x (M)" rather that "M.x" to distinguish them
              -- from the global kind.
            ; let ppr_for_ticky_name :: SDoc
                  ppr_for_ticky_name =
                    let n :: SDoc
    n = Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name
                        ext :: SDoc
    ext = SDoc
    forall doc. IsOutput doc => doc
    empty -- parens (text "tagged")
                        p :: SDoc
    p = case CLabel -> Maybe Name
    hasHaskellName CLabel
    parent of
                                -- NB the default "top" ticky ctr does not
                                -- have a Haskell name
                              Just Name
    pname -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "at" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SrcLoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> SrcLoc
    nameSrcLoc Name
    pname) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                                              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    pprNameUnqualified Name
    name
                              Maybe Name
    _ -> SDoc
    forall doc. IsOutput doc => doc
    empty
                    in if Name -> Bool
    isInternalName Name
    name
                       then SDoc
    n SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod_name) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    ext SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    p
                       else SDoc
    n SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    ext SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    p
            ; sdoc_context <- stgToCmmContext <$> getStgToCmmConfig
            ; fun_descr_lit <- newStringCLit $ renderWithContext sdoc_context ppr_for_ticky_name
            ; arg_descr_lit <- newStringCLit $ "infer"
            ; json_descr_lit <- newStringCLit $ "infer"
            ; emitTickyData platform ctr_lbl 0 fun_descr_lit arg_descr_lit json_descr_lit (zeroCLit platform)
            }
    -- -----------------------------------------------------------------------------
    -- Ticky stack frames

    tickyPushUpdateFrame, tickyUpdateFrameOmitted :: FCode ()
    tickyPushUpdateFrame :: FCode ()
    tickyPushUpdateFrame    = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "UPDF_PUSHED_ctr")
    tickyUpdateFrameOmitted :: FCode ()
    tickyUpdateFrameOmitted = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "UPDF_OMITTED_ctr")

    -- -----------------------------------------------------------------------------
    -- Ticky entries

    -- NB the name-specific entries are only available for names that have
    -- dedicated Cmm code. As far as I know, this just rules out
    -- constructor thunks. For them, there is no CMM code block to put the
    -- bump of name-specific ticky counter into. On the other hand, we can
    -- still track allocation their allocation.

    tickyEnterDynCon :: FCode ()
    tickyEnterDynCon :: FCode ()
    tickyEnterDynCon = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "ENT_DYN_CON_ctr")

    tickyEnterThunk :: ClosureInfo -> FCode ()
    tickyEnterThunk :: ClosureInfo -> FCode ()
    tickyEnterThunk ClosureInfo
    cl_info
      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
        { FastString -> FCode ()
    bumpTickyCounter FastString
    ctr
        ; has_ctr <- Bool -> FCode Bool
    thunkHasCounter Bool
    static
        ; when has_ctr $ do
          ticky_ctr_lbl <- getTickyCtrLabel
          registerTickyCtrAtEntryDyn ticky_ctr_lbl
          bumpTickyEntryCount ticky_ctr_lbl }
      where
        updatable :: Bool
    updatable = Bool -> Bool
    not (ClosureInfo -> Bool
    closureUpdReqd ClosureInfo
    cl_info)
        static :: Bool
    static    = ClosureInfo -> Bool
    isStaticClosure ClosureInfo
    cl_info

        ctr :: FastString
    ctr | Bool
    static    = if Bool
    updatable then String -> FastString
    fsLit String
    "ENT_STATIC_THK_SINGLE_ctr"
                                       else String -> FastString
    fsLit String
    "ENT_STATIC_THK_MANY_ctr"
            | Bool
    otherwise = if Bool
    updatable then String -> FastString
    fsLit String
    "ENT_DYN_THK_SINGLE_ctr"
                                       else String -> FastString
    fsLit String
    "ENT_DYN_THK_MANY_ctr"

    tickyUpdateBhCaf :: ClosureInfo -> FCode ()
    tickyUpdateBhCaf :: ClosureInfo -> FCode ()
    tickyUpdateBhCaf ClosureInfo
    cl_info
      = FCode () -> FCode ()
    ifTicky (FastString -> FCode ()
    bumpTickyCounter FastString
    ctr)
      where
        ctr :: FastString
    ctr | ClosureInfo -> Bool
    closureUpdReqd ClosureInfo
    cl_info = (String -> FastString
    fsLit String
    "UPD_CAF_BH_SINGLE_ENTRY_ctr")
            | Bool
    otherwise              = (String -> FastString
    fsLit String
    "UPD_CAF_BH_UPDATABLE_ctr")

    tickyEnterFun :: ClosureInfo -> FCode ()
    tickyEnterFun :: ClosureInfo -> FCode ()
    tickyEnterFun ClosureInfo
    cl_info = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      ctr_lbl <- FCode CLabel
    getTickyCtrLabel

      if isStaticClosure cl_info
        then do bumpTickyCounter (fsLit "ENT_STATIC_FUN_DIRECT_ctr")
                registerTickyCtr ctr_lbl
        else do bumpTickyCounter (fsLit "ENT_DYN_FUN_DIRECT_ctr")
                registerTickyCtrAtEntryDyn ctr_lbl

      bumpTickyEntryCount ctr_lbl

    tickyEnterLNE :: FCode ()
    tickyEnterLNE :: FCode ()
    tickyEnterLNE = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "ENT_LNE_ctr")
      FCode () -> FCode ()
    ifTickyLNE (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
        ctr_lbl <- FCode CLabel
    getTickyCtrLabel
        registerTickyCtr ctr_lbl
        bumpTickyEntryCount ctr_lbl

    -- needn't register a counter upon entry if
    --
    -- 1) it's for a dynamic closure, and
    --
    -- 2) -ticky-allocd is on
    --
    -- since the counter was registered already upon being alloc'd
    registerTickyCtrAtEntryDyn :: CLabel -> FCode ()
    registerTickyCtrAtEntryDyn :: CLabel -> FCode ()
    registerTickyCtrAtEntryDyn CLabel
    ctr_lbl = do
      already_registered <- (StgToCmmConfig -> Bool) -> FCode Bool
    isEnabled StgToCmmConfig -> Bool
    stgToCmmTickyAllocd
      unless already_registered $ registerTickyCtr ctr_lbl

    -- | Register a ticky counter.
    --
    -- It's important that this does not race with other entries of the same
    -- closure, lest the ticky_entry_ctrs list may become cyclic. However, we also
    -- need to make sure that this is reasonably efficient. Consequently, we first
    -- perform a normal load of the counter's "registered" flag to check whether
    -- registration is necessary. If so, then we do a compare-and-swap to lock the
    -- counter for registration and use an atomic-exchange to add the counter to the list.
    --
    -- @
    -- if ( f_ct.registeredp == 0 ) {
    --    if (cas(f_ct.registeredp, 0, 1) == 0) {
    --        old_head = xchg(ticky_entry_ctrs,  f_ct);
    --        f_ct.link = old_head;
    --    }
    -- }
    -- @
    registerTickyCtr :: CLabel -> FCode ()
    registerTickyCtr :: CLabel -> FCode ()
    registerTickyCtr CLabel
    ctr_lbl = do
      platform <- FCode Platform
    getPlatform
      let constants = Platform -> PlatformConstants
    platformConstants Platform
    platform
          word_width = Platform -> Width
    wordWidth Platform
    platform
          registeredp = CmmLit -> CmmExpr
    CmmLit (CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    ctr_lbl (PlatformConstants -> Int
    pc_OFFSET_StgEntCounter_registeredp PlatformConstants
    constants))

      register_stmts <- getCode $ do
        old_head <- newTemp (bWord platform)
        let ticky_entry_ctrs = CLabel -> CmmExpr
    mkLblExpr (FastString -> CLabel
    mkRtsCmmDataLabel (String -> FastString
    fsLit String
    "ticky_entry_ctrs"))
            link = CmmLit -> CmmExpr
    CmmLit (CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    ctr_lbl (PlatformConstants -> Int
    pc_OFFSET_StgEntCounter_link PlatformConstants
    constants))
        emitPrimCall [old_head] (MO_Xchg word_width) [ticky_entry_ctrs, mkLblExpr ctr_lbl]
        emitStore link (CmmReg $ CmmLocal old_head)

      cas_test <- getCode $ do
        old <- newTemp (bWord platform)
        emitPrimCall [old] (MO_Cmpxchg word_width)
            [registeredp, zeroExpr platform, mkIntExpr platform 1]
        let locked = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform (CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ LocalReg -> CmmReg
    CmmLocal LocalReg
    old) (Platform -> CmmExpr
    zeroExpr Platform
    platform)
        emit =<< mkCmmIfThen locked register_stmts

      let test = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform (Platform -> CmmExpr -> CmmExpr
    cmmLoadBWord Platform
    platform CmmExpr
    registeredp) (Platform -> CmmExpr
    zeroExpr Platform
    platform)
      emit =<< mkCmmIfThen test cas_test

    tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
    tickyReturnOldCon :: Int -> FCode ()
    tickyReturnOldCon Int
    arity
      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do { FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "RET_OLD_ctr")
                     ; FastString -> Int -> FCode ()
    bumpHistogram    (String -> FastString
    fsLit String
    "RET_OLD_hst") Int
    arity }
    tickyReturnNewCon :: Int -> FCode ()
    tickyReturnNewCon Int
    arity
      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do { FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "RET_NEW_ctr")
                     ; FastString -> Int -> FCode ()
    bumpHistogram    (String -> FastString
    fsLit String
    "RET_NEW_hst") Int
    arity }

    tickyUnboxedTupleReturn :: RepArity -> FCode ()
    tickyUnboxedTupleReturn :: Int -> FCode ()
    tickyUnboxedTupleReturn Int
    arity
      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do { FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "RET_UNBOXED_TUP_ctr")
                     ; FastString -> Int -> FCode ()
    bumpHistogram    (String -> FastString
    fsLit String
    "RET_UNBOXED_TUP_hst") Int
    arity }

    -- -----------------------------------------------------------------------------
    -- Ticky calls

    -- Ticks at a *call site*:
    tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
    tickyDirectCall :: Int -> [StgArg] -> FCode ()
    tickyDirectCall Int
    arity [StgArg]
    args
      | [StgArg]
    args [StgArg] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Int
    arity = FCode ()
    tickyKnownCallExact
      | Bool
    otherwise = do FCode ()
    tickyKnownCallExtraArgs
                       [StgArg] -> FCode ()
    tickySlowCallPat (Int -> [StgArg] -> [StgArg]
    forall a. Int -> [a] -> [a]
    drop Int
    arity [StgArg]
    args)

    tickyKnownCallTooFewArgs :: FCode ()
    tickyKnownCallTooFewArgs :: FCode ()
    tickyKnownCallTooFewArgs = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "KNOWN_CALL_TOO_FEW_ARGS_ctr")

    tickyKnownCallExact :: FCode ()
    tickyKnownCallExact :: FCode ()
    tickyKnownCallExact      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "KNOWN_CALL_ctr")

    tickyKnownCallExtraArgs :: FCode ()
    tickyKnownCallExtraArgs :: FCode ()
    tickyKnownCallExtraArgs  = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "KNOWN_CALL_EXTRA_ARGS_ctr")

    tickyUnknownCall :: FCode ()
    tickyUnknownCall :: FCode ()
    tickyUnknownCall         = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "UNKNOWN_CALL_ctr")

    -- Tick for the call pattern at slow call site (i.e. in addition to
    -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)
    tickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode ()
    tickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode ()
    tickySlowCall LambdaFormInfo
    _ [] = () -> FCode ()
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    tickySlowCall LambdaFormInfo
    lf_info [StgArg]
    args = do
     -- see Note [Ticky for slow calls]
     if LambdaFormInfo -> Bool
    isKnownFun LambdaFormInfo
    lf_info
       then FCode ()
    tickyKnownCallTooFewArgs
       else FCode ()
    tickyUnknownCall
     [StgArg] -> FCode ()
    tickySlowCallPat [StgArg]
    args

    tickySlowCallPat :: [StgArg] -> FCode ()
    tickySlowCallPat :: [StgArg] -> FCode ()
    tickySlowCallPat [StgArg]
    args = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      platform <- Profile -> Platform
    profilePlatform (Profile -> Platform) -> FCode Profile -> FCode Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode Profile
    getProfile
      let argReps = (StgArg -> ArgRep) -> [StgArg] -> [ArgRep]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> PrimOrVoidRep -> ArgRep
    toArgRepOrV Platform
    platform (PrimOrVoidRep -> ArgRep)
    -> (StgArg -> PrimOrVoidRep) -> StgArg -> ArgRep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> PrimOrVoidRep
    stgArgRep1) [StgArg]
    args
          (_, n_matched) = slowCallPattern argReps
      if n_matched > 0 && args `lengthIs` n_matched
         then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
         else bumpTickyCounter $ fsLit "VERY_SLOW_CALL_ctr"

    {-

    Note [Ticky for slow calls]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Terminology is unfortunately a bit mixed up for these calls. codeGen
    uses "slow call" to refer to unknown calls and under-saturated known
    calls.

    Nowadays, though (ie as of the eval/apply paper), the significantly
    slower calls are actually just a subset of these: the ones with no
    built-in argument pattern (cf GHC.StgToCmm.ArgRep.slowCallPattern)

    So for ticky profiling, we split slow calls into
    "SLOW_CALL_fast_<pattern>_ctr" (those matching a built-in pattern) and
    VERY_SLOW_CALL_ctr (those without a built-in pattern; these are very
    bad for both space and time).

    -}

    -- -----------------------------------------------------------------------------
    -- Ticky allocation

    tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
    -- Called when doing a dynamic heap allocation; the LambdaFormInfo
    -- used to distinguish between closure types
    --
    -- TODO what else to count while we're here?
    tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
    tickyDynAlloc Maybe Id
    mb_id SMRep
    rep LambdaFormInfo
    lf = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      profile <- FCode Profile
    getProfile
      let platform = Profile -> Platform
    profilePlatform Profile
    profile
          bytes = Platform -> Int
    platformWordSizeInBytes Platform
    platform Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Profile -> SMRep -> Int
    heapClosureSizeW Profile
    profile SMRep
    rep

          countGlobal FastString
    tot FastString
    ctr = do
            FastString -> Int -> FCode ()
    bumpTickyCounterBy FastString
    tot Int
    bytes
            FastString -> FCode ()
    bumpTickyCounter   FastString
    ctr
          countSpecific = FCode () -> FCode ()
    ifTickyAllocd (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ case Maybe Id
    mb_id of
            Maybe Id
    Nothing -> () -> FCode ()
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just Id
    id -> do
              let ctr_lbl :: CLabel
    ctr_lbl = Name -> CLabel
    mkRednCountsLabel (Id -> Name
    idName Id
    id)
              CLabel -> FCode ()
    registerTickyCtr CLabel
    ctr_lbl
              CLabel -> Int -> FCode ()
    bumpTickyAllocd CLabel
    ctr_lbl Int
    bytes

      -- TODO are we still tracking "good stuff" (_gds) versus
      -- administrative (_adm) versus slop (_slp)? I'm going with all _gds
      -- for now, since I don't currently know neither if we do nor how to
      -- distinguish. NSF Mar 2013

      if | isConRep rep   ->
             ifTickyDynThunk countSpecific >>
             countGlobal (fsLit "ALLOC_CON_gds") (fsLit "ALLOC_CON_ctr")
         | isThunkRep rep ->
             ifTickyDynThunk countSpecific >>
             if lfUpdatable lf
             then countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_UP_THK_ctr")
             else countGlobal (fsLit "ALLOC_THK_gds") (fsLit "ALLOC_SE_THK_ctr")
         | isFunRep   rep ->
             countSpecific >>
             countGlobal (fsLit "ALLOC_FUN_gds") (fsLit "ALLOC_FUN_ctr")
         | otherwise      -> panic "How is this heap object not a con, thunk, or fun?"

    tickyAllocHeap ::
      Bool -> -- is this a genuine allocation? As opposed to
              -- GHC.StgToCmm.Layout.adjustHpBackwards
      VirtualHpOffset -> FCode ()
    -- Called when doing a heap check [TICK_ALLOC_HEAP]
    -- Must be lazy in the amount of allocation!
    tickyAllocHeap :: Bool -> Int -> FCode ()
    tickyAllocHeap Bool
    genuine Int
    hp
      = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
        do  { platform <- FCode Platform
    getPlatform
            ; ticky_ctr <- getTickyCtrLabel
            ; emit $ catAGraphs $
                -- only test hp from within the emit so that the monadic
                -- computation itself is not strict in hp (cf knot in
                -- GHC.StgToCmm.Monad.getHeapUsage)
              if hp == 0 then []
              else let !bytes = Platform -> Int
    platformWordSizeInBytes Platform
    platform Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    hp in [
                -- Bump the allocation total in the closure's StgEntCounter
                addToMem (rEP_StgEntCounter_allocs platform)
                         (CmmLit (cmmLabelOffB ticky_ctr (pc_OFFSET_StgEntCounter_allocs (platformConstants platform))))
                         bytes,
                -- Bump the global allocation total ALLOC_HEAP_tot
                addToMemLbl (bWord platform)
                            (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_tot"))
                            bytes,
                -- Bump the global allocation counter ALLOC_HEAP_ctr
                if not genuine then mkNop
                else addToMemLbl (bWord platform)
                                 (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_ctr"))
                                 1
                ]}

    --------------------------------------------------------------------------------
    -- these three are only called from GHC.Cmm.Parser (ie ultimately from the RTS)

    -- the units are bytes

    tickyAllocPrim :: CmmExpr  -- ^ size of the full header, in bytes
                   -> CmmExpr  -- ^ size of the payload, in bytes
                   -> CmmExpr -> FCode ()
    tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
    tickyAllocPrim CmmExpr
    _hdr CmmExpr
    _goods CmmExpr
    _slop = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      FastString -> FCode ()
    bumpTickyCounter    (String -> FastString
    fsLit String
    "ALLOC_PRIM_ctr")
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_PRIM_adm") CmmExpr
    _hdr
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_PRIM_gds") CmmExpr
    _goods
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_PRIM_slp") CmmExpr
    _slop

    tickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()
    tickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()
    tickyAllocThunk CmmExpr
    _goods CmmExpr
    _slop = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- TODO is it ever called with a Single-Entry thunk?
      FastString -> FCode ()
    bumpTickyCounter    (String -> FastString
    fsLit String
    "ALLOC_UP_THK_ctr")
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_THK_gds") CmmExpr
    _goods
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_THK_slp") CmmExpr
    _slop

    tickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()
    tickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()
    tickyAllocPAP CmmExpr
    _goods CmmExpr
    _slop = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      FastString -> FCode ()
    bumpTickyCounter    (String -> FastString
    fsLit String
    "ALLOC_PAP_ctr")
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_PAP_gds") CmmExpr
    _goods
      FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "ALLOC_PAP_slp") CmmExpr
    _slop

    tickyHeapCheck :: FCode ()
    tickyHeapCheck :: FCode ()
    tickyHeapCheck = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "HEAP_CHK_ctr")

    tickyStackCheck :: FCode ()
    tickyStackCheck :: FCode ()
    tickyStackCheck = FCode () -> FCode ()
    ifTicky (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "STK_CHK_ctr")

    -- -----------------------------------------------------------------------------
    -- Ticky for tag inference characterisation

    -- | Predicted a pointer would be tagged correctly (GHC will crash if not so no miss case)
    tickyTagged :: FCode ()
    tickyTagged :: FCode ()
    tickyTagged         = FCode () -> FCode ()
    ifTickyTag (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "TAG_TAGGED_pred")

    -- | Pass a boolean expr indicating if tag was present.
    tickyUntagged :: CmmExpr -> FCode ()
    tickyUntagged :: CmmExpr -> FCode ()
    tickyUntagged CmmExpr
    e     = do
        FCode () -> FCode ()
    ifTickyTag (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FCode ()
    bumpTickyCounter (String -> FastString
    fsLit String
    "TAG_UNTAGGED_pred")
        FCode () -> FCode ()
    ifTickyTag (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE (String -> FastString
    fsLit String
    "TAG_UNTAGGED_miss") CmmExpr
    e

    -- | Called when for `case v of ...` we can avoid entering v based on
    -- tag inference information.
    tickyTagSkip :: Unique -> Id -> FCode ()
    tickyTagSkip :: Unique -> Id -> FCode ()
    tickyTagSkip Unique
    unique Id
    id = FCode () -> FCode ()
    ifTickyTag (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
      let ctr_lbl :: CLabel
    ctr_lbl = Name -> Unique -> CLabel
    mkTagHitLabel (Id -> Name
    idName Id
    id) Unique
    unique
      CLabel -> FCode ()
    registerTickyCtr CLabel
    ctr_lbl
      CLabel -> FCode ()
    bumpTickyTagSkip CLabel
    ctr_lbl

    -- -----------------------------------------------------------------------------
    -- Ticky utils

    isEnabled :: (StgToCmmConfig -> Bool) -> FCode Bool
    isEnabled :: (StgToCmmConfig -> Bool) -> FCode Bool
    isEnabled = ((StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool)
    -> FCode StgToCmmConfig -> (StgToCmmConfig -> Bool) -> FCode Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
    forall a b. (a -> b) -> FCode a -> FCode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FCode StgToCmmConfig
    getStgToCmmConfig

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

    ifTicky :: FCode () -> FCode ()
    ifTicky :: FCode () -> FCode ()
    ifTicky = (StgToCmmConfig -> Bool) -> FCode () -> FCode ()
    runIfFlag StgToCmmConfig -> Bool
    stgToCmmDoTicky

    ifTickyTag :: FCode () -> FCode ()
    ifTickyTag :: FCode () -> FCode ()
    ifTickyTag = (StgToCmmConfig -> Bool) -> FCode () -> FCode ()
    runIfFlag StgToCmmConfig -> Bool
    stgToCmmTickyTag

    ifTickyAllocd :: FCode () -> FCode ()
    ifTickyAllocd :: FCode () -> FCode ()
    ifTickyAllocd = (StgToCmmConfig -> Bool) -> FCode () -> FCode ()
    runIfFlag StgToCmmConfig -> Bool
    stgToCmmTickyAllocd

    ifTickyLNE :: FCode () -> FCode ()
    ifTickyLNE :: FCode () -> FCode ()
    ifTickyLNE = (StgToCmmConfig -> Bool) -> FCode () -> FCode ()
    runIfFlag StgToCmmConfig -> Bool
    stgToCmmTickyLNE

    ifTickyDynThunk :: FCode () -> FCode ()
    ifTickyDynThunk :: FCode () -> FCode ()
    ifTickyDynThunk = (StgToCmmConfig -> Bool) -> FCode () -> FCode ()
    runIfFlag StgToCmmConfig -> Bool
    stgToCmmTickyDynThunk

    bumpTickyCounter :: FastString -> FCode ()
    bumpTickyCounter :: FastString -> FCode ()
    bumpTickyCounter = CLabel -> FCode ()
    bumpTickyLbl (CLabel -> FCode ())
    -> (FastString -> CLabel) -> FastString -> FCode ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> CLabel
    mkRtsCmmDataLabel

    bumpTickyCounterBy :: FastString -> Int -> FCode ()
    bumpTickyCounterBy :: FastString -> Int -> FCode ()
    bumpTickyCounterBy = CLabel -> Int -> FCode ()
    bumpTickyLblBy (CLabel -> Int -> FCode ())
    -> (FastString -> CLabel) -> FastString -> Int -> FCode ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> CLabel
    mkRtsCmmDataLabel

    bumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()
    bumpTickyCounterByE FastString
    lbl = CLabel -> CmmExpr -> FCode ()
    bumpTickyLblByE (FastString -> CLabel
    mkRtsCmmDataLabel FastString
    lbl)

    bumpTickyEntryCount :: CLabel -> FCode ()
    bumpTickyEntryCount :: CLabel -> FCode ()
    bumpTickyEntryCount CLabel
    lbl = do
      platform <- FCode Platform
    getPlatform
      bumpTickyLit (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform)))

    bumpTickyAllocd :: CLabel -> Int -> FCode ()
    bumpTickyAllocd :: CLabel -> Int -> FCode ()
    bumpTickyAllocd CLabel
    lbl Int
    bytes = do
      platform <- FCode Platform
    getPlatform
      bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform))) bytes

    bumpTickyTagSkip :: CLabel -> FCode ()
    bumpTickyTagSkip :: CLabel -> FCode ()
    bumpTickyTagSkip CLabel
    lbl = do
      platform <- FCode Platform
    getPlatform
      bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform))) 1

    bumpTickyLbl :: CLabel -> FCode ()
    bumpTickyLbl :: CLabel -> FCode ()
    bumpTickyLbl CLabel
    lhs = CmmLit -> Int -> FCode ()
    bumpTickyLitBy (CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    lhs Int
    0) Int
    1

    bumpTickyLblBy :: CLabel -> Int -> FCode ()
    bumpTickyLblBy :: CLabel -> Int -> FCode ()
    bumpTickyLblBy CLabel
    lhs = CmmLit -> Int -> FCode ()
    bumpTickyLitBy (CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    lhs Int
    0)

    bumpTickyLblByE :: CLabel -> CmmExpr -> FCode ()
    bumpTickyLblByE :: CLabel -> CmmExpr -> FCode ()
    bumpTickyLblByE CLabel
    lhs = CmmLit -> CmmExpr -> FCode ()
    bumpTickyLitByE (CLabel -> Int -> CmmLit
    cmmLabelOffB CLabel
    lhs Int
    0)

    bumpTickyLit :: CmmLit -> FCode ()
    bumpTickyLit :: CmmLit -> FCode ()
    bumpTickyLit CmmLit
    lhs = CmmLit -> Int -> FCode ()
    bumpTickyLitBy CmmLit
    lhs Int
    1

    bumpTickyLitBy :: CmmLit -> Int -> FCode ()
    bumpTickyLitBy :: CmmLit -> Int -> FCode ()
    bumpTickyLitBy CmmLit
    lhs Int
    n = CmmExpr -> Int -> FCode ()
    emitAddToMem (CmmLit -> CmmExpr
    CmmLit CmmLit
    lhs) Int
    n

    bumpTickyLitByE :: CmmLit -> CmmExpr -> FCode ()
    bumpTickyLitByE :: CmmLit -> CmmExpr -> FCode ()
    bumpTickyLitByE CmmLit
    lhs CmmExpr
    e = CmmExpr -> CmmExpr -> FCode ()
    emitAddToMemE (CmmLit -> CmmExpr
    CmmLit CmmLit
    lhs) CmmExpr
    e

    bumpHistogram :: FastString -> Int -> FCode ()
    bumpHistogram :: FastString -> Int -> FCode ()
    bumpHistogram FastString
    lbl Int
    n = do
        platform <- FCode Platform
    getPlatform
        let offset = Int
    n Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` (PlatformConstants -> Int
    pc_TICKY_BIN_COUNT (Platform -> PlatformConstants
    platformConstants Platform
    platform) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
        let addr =
               Platform -> Width -> CmmExpr -> CmmExpr -> CmmExpr
    cmmIndexExpr Platform
    platform
                    (Platform -> Width
    wordWidth Platform
    platform)
                    (CmmLit -> CmmExpr
    CmmLit (CLabel -> CmmLit
    CmmLabel (FastString -> CLabel
    mkRtsCmmDataLabel FastString
    lbl)))
                    (CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    offset) (Platform -> Width
    wordWidth Platform
    platform)))
        emitAddToMem addr 1

    emitAddToMem :: CmmExpr -> Int -> FCode ()
    emitAddToMem :: CmmExpr -> Int -> FCode ()
    emitAddToMem CmmExpr
    lhs Int
    n = do
      platform <- FCode Platform
    getPlatform
      emitAddToMemE lhs (mkIntExpr platform n)

    emitAddToMemE :: CmmExpr -> CmmExpr -> FCode ()
    emitAddToMemE :: CmmExpr -> CmmExpr -> FCode ()
    emitAddToMemE CmmExpr
    lhs CmmExpr
    n = do
      platform <- FCode Platform
    getPlatform
      val <- newTemp (bWord platform)
      emitAtomicRead MemOrderRelaxed val lhs
      let val' = Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmOffsetExpr Platform
    platform (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    val)) CmmExpr
    n
      emitAtomicWrite MemOrderRelaxed lhs val'

    ------------------------------------------------------------------
    -- Showing the "type category" for ticky-ticky profiling

    showTypeCategory :: Type -> Char
      {-
            +           dictionary

            >           function

            {C,I,F,D,W} char, int, float, double, word
            {c,i,f,d,w} unboxed ditto

            T           tuple

            P           other primitive type
            p           unboxed ditto

            L           list
            E           enumeration type
            S           other single-constructor type
            M           other multi-constructor data-con type

            .           other type

            -           reserved for others to mark as "uninteresting"

      Accurate as of Mar 2013, but I eliminated the Array category instead
      of updating it, for simplicity. It's in P/p, I think --NSF

        -}
    showTypeCategory :: Type -> Char
    showTypeCategory Type
    ty
      | Type -> Bool
    isDictTy Type
    ty = Char
    '+'
      | Bool
    otherwise = case HasCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    tcSplitTyConApp_maybe Type
    ty of
      Maybe (TyCon, [Type])
    Nothing -> Char
    '.'
      Just (TyCon
    tycon, [Type]
    _) ->
        case () of
          ()
    _ | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    fUNTyConKey] -> Char
    '>'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    charTyConKey] -> Char
    'C'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    charPrimTyConKey] -> Char
    'c'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    doubleTyConKey] -> Char
    'D'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    doublePrimTyConKey] -> Char
    'd'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    floatTyConKey] -> Char
    'F'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    floatPrimTyConKey] -> Char
    'f'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    intTyConKey, Unique
    int8TyConKey, Unique
    int16TyConKey, Unique
    int32TyConKey, Unique
    int64TyConKey] -> Char
    'I'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    intPrimTyConKey, Unique
    int8PrimTyConKey, Unique
    int16PrimTyConKey, Unique
    int32PrimTyConKey, Unique
    int64PrimTyConKey] -> Char
    'i'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    wordTyConKey, Unique
    word8TyConKey, Unique
    word16TyConKey, Unique
    word32TyConKey, Unique
    word64TyConKey] -> Char
    'W'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    wordPrimTyConKey, Unique
    word8PrimTyConKey, Unique
    word16PrimTyConKey, Unique
    word32PrimTyConKey, Unique
    word64PrimTyConKey] -> Char
    'w'
            | TyCon -> [Unique] -> Bool
    forall a. Uniquable a => a -> [Unique] -> Bool
    anyOfUnique TyCon
    tycon [Unique
    listTyConKey] -> Char
    'L'
            | TyCon -> Bool
    isUnboxedTupleTyCon TyCon
    tycon -> Char
    't'
            | TyCon -> Bool
    isTupleTyCon TyCon
    tycon       -> Char
    'T'
            | TyCon -> Bool
    isPrimTyCon TyCon
    tycon        -> Char
    'P'
            | TyCon -> Bool
    isEnumerationTyCon TyCon
    tycon -> Char
    'E'
            | Maybe DataCon -> Bool
    forall a. Maybe a -> Bool
    isJust (TyCon -> Maybe DataCon
    tyConSingleDataCon_maybe TyCon
    tycon) -> Char
    'S'
            | Bool
    otherwise -> Char
    'M' -- oh, well...