Commit 6c2c853b authored by Joachim Breitner's avatar Joachim Breitner Committed by Ben Gamari
Browse files

Various ticky-related work

this Diff contains small, self-contained changes as I work towards
fixing #10613. It is mostly created to let harbormaster do its job, but
feedback is welcome as well.

Please do not merge this via arc; I’d like to push the individual
patches as layed out here. I might push mostly trivial ones even without
review, as long as the build passes.

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2014
parent 03a1bb4d
......@@ -206,7 +206,7 @@ cgRhs :: Id
)
cgRhs id (StgRhsCon cc con args)
= withNewTickyCounterThunk False (idName id) $ -- False for "not static"
= withNewTickyCounterCon (idName id) $
buildDynCon id True cc con args
{- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}
......@@ -386,7 +386,7 @@ cgRhsStdThunk bndr lf_info payload
}
where
gen_code reg -- AHA! A STANDARD-FORM THUNK
= withNewTickyCounterStdThunk False (idName bndr) $ -- False for "not static"
= withNewTickyCounterStdThunk (lfUpdatable lf_info) (idName bndr) $
do
{ -- LAY OUT THE OBJECT
mod_name <- getModuleName
......@@ -402,7 +402,6 @@ cgRhsStdThunk bndr lf_info payload
-- ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
; let use_cc = curCCS; blame_cc = curCCS
; tickyEnterStdThunk closure_info
-- BUILD THE OBJECT
; let info_tbl = mkCmmInfo closure_info
......@@ -453,7 +452,10 @@ closureCodeBody :: Bool -- whether this is a top-level binding
closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
| arity == 0 -- No args i.e. thunk
= withNewTickyCounterThunk (isStaticClosure cl_info) (closureName cl_info) $
= withNewTickyCounterThunk
(isStaticClosure cl_info)
(closureUpdReqd cl_info)
(closureName cl_info) $
emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
\(_, node, _) -> thunkCode cl_info fv_details cc node arity body
where
......@@ -576,8 +578,7 @@ thunkCode cl_info fv_details _cc node arity body
-- that cc of enclosing scope will be recorded
-- in update frame CAF/DICT functions will be
-- subsumed by this enclosing cc
do { tickyEnterThunk cl_info
; enterCostCentreThunk (CmmReg nodeReg)
do { enterCostCentreThunk (CmmReg nodeReg)
; let lf_info = closureLFInfo cl_info
; fv_bindings <- mapM bind_fv fv_details
; load_fvs node lf_info fv_bindings
......
......@@ -328,8 +328,7 @@ ldvRecordCreate closure = do
--
-- | 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@ or @IND_OLDGEN@ because neither is considered
-- for LDV profiling.
-- closure is not @IND@ because that is not considered for LDV profiling.
--
ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
ldvEnterClosure closure_info node_reg = do
......
......@@ -70,6 +70,7 @@ module StgCmmTicky (
withNewTickyCounterLNE,
withNewTickyCounterThunk,
withNewTickyCounterStdThunk,
withNewTickyCounterCon,
tickyDynAlloc,
tickyAllocHeap,
......@@ -143,7 +144,13 @@ import Control.Monad ( unless, when )
--
-----------------------------------------------------------------------------
data TickyClosureType = TickyFun | TickyThunk | TickyLNE
data TickyClosureType
= TickyFun
| TickyCon
| TickyThunk
Bool -- True <-> updateable
Bool -- True <-> standard thunk (AP or selector), has no entry counter
| TickyLNE
withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a
withNewTickyCounterFun = withNewTickyCounter TickyFun
......@@ -152,15 +159,38 @@ withNewTickyCounterLNE nm args code = do
b <- tickyLNEIsOn
if not b then code else withNewTickyCounter TickyLNE nm args code
withNewTickyCounterThunk,withNewTickyCounterStdThunk ::
Bool -> Name -> FCode a -> FCode a
withNewTickyCounterThunk isStatic name code = do
withNewTickyCounterThunk
:: Bool -- ^ static
-> Bool -- ^ updateable
-> Name
-> FCode a
-> FCode a
withNewTickyCounterThunk isStatic isUpdatable name code = do
b <- tickyDynThunkIsOn
if isStatic || not b -- ignore static thunks
then code
else withNewTickyCounter TickyThunk name [] code
else withNewTickyCounter (TickyThunk isUpdatable False) name [] code
withNewTickyCounterStdThunk
:: Bool -- ^ updateable
-> Name
-> FCode a
-> FCode a
withNewTickyCounterStdThunk isUpdatable name code = do
b <- tickyDynThunkIsOn
if not b
then code
else withNewTickyCounter (TickyThunk isUpdatable True) name [] code
withNewTickyCounterStdThunk = withNewTickyCounterThunk
withNewTickyCounterCon
:: Name
-> FCode a
-> FCode a
withNewTickyCounterCon name code = do
b <- tickyDynThunkIsOn
if not b
then code
else withNewTickyCounter TickyCon name [] code
-- args does not include the void arguments
withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
......@@ -184,21 +214,21 @@ emitTickyCounter cloType name args
; let ppr_for_ticky_name :: SDoc
ppr_for_ticky_name =
let n = ppr name
ext = case cloType of
TickyFun -> empty
TickyCon -> parens (text "con")
TickyThunk upd std -> parens $ hcat $ punctuate comma $
[text "thk"] ++ [text "se"|not upd] ++ [text "std"|std]
TickyLNE | isInternalName name -> parens (text "LNE")
| otherwise -> panic "emitTickyCounter: how is this an external LNE?"
p = case hasHaskellName parent of
-- NB the default "top" ticky ctr does not
-- have a Haskell name
Just pname -> text "in" <+> ppr (nameUnique pname)
_ -> empty
in (<+> p) $ if isInternalName name
then let s = n <+> (parens (ppr mod_name))
in case cloType of
TickyFun -> s
TickyThunk -> s <+> parens (text "thk")
TickyLNE -> s <+> parens (text "LNE")
else case cloType of
TickyFun -> n
TickyThunk -> n <+> parens (text "thk")
TickyLNE -> panic "emitTickyCounter: how is this an external LNE?"
in if isInternalName name
then n <+> parens (ppr mod_name) <+> ext <+> p
else n <+> ext <+> p
; fun_descr_lit <- newStringCLit $ showSDocDebug dflags ppr_for_ticky_name
; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . unsafe_stripNV) args
......
......@@ -1533,7 +1533,7 @@ scavenge_one(StgPtr p)
} else {
size = gen->scan - start;
}
debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
debugBelch("evac IND: %ld bytes", size * sizeof(W_));
}
#endif
break;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment