[commit: ghc] master: Various ticky-related work (6c2c853)
git at git.haskell.org
git at git.haskell.org
Thu Mar 24 09:51:38 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/6c2c853b11fe25c106469da7b105e2be596c17de/ghc
>---------------------------------------------------------------
commit 6c2c853b11fe25c106469da7b105e2be596c17de
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Mar 23 16:20:36 2016 +0100
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
>---------------------------------------------------------------
6c2c853b11fe25c106469da7b105e2be596c17de
compiler/codeGen/StgCmmBind.hs | 13 +++++----
compiler/codeGen/StgCmmProf.hs | 3 +-
compiler/codeGen/StgCmmTicky.hs | 62 ++++++++++++++++++++++++++++++-----------
rts/sm/Scav.c | 2 +-
4 files changed, 55 insertions(+), 25 deletions(-)
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index f34186a..eae599c 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -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
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index c1b149d..434d7b5 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -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
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index 95dfa99..0ffe6a3 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -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
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 953f055..abb7726 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -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;
More information about the ghc-commits
mailing list