diff options
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 13 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 3 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 62 | ||||
| -rw-r--r-- | rts/sm/Scav.c | 2 |
4 files changed, 25 insertions, 55 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index eae599ca6c..f34186a8ac 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -206,7 +206,7 @@ cgRhs :: Id ) cgRhs id (StgRhsCon cc con args) - = withNewTickyCounterCon (idName id) $ + = withNewTickyCounterThunk False (idName id) $ -- False for "not static" 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 (lfUpdatable lf_info) (idName bndr) $ + = withNewTickyCounterStdThunk False (idName bndr) $ -- False for "not static" do { -- LAY OUT THE OBJECT mod_name <- getModuleName @@ -402,6 +402,7 @@ 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 @@ -452,10 +453,7 @@ 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) - (closureUpdReqd cl_info) - (closureName cl_info) $ + = withNewTickyCounterThunk (isStaticClosure cl_info) (closureName cl_info) $ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $ \(_, node, _) -> thunkCode cl_info fv_details cc node arity body where @@ -578,7 +576,8 @@ 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 { enterCostCentreThunk (CmmReg nodeReg) + do { tickyEnterThunk cl_info + ; 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 434d7b50de..c1b149dba2 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -328,7 +328,8 @@ 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@ because that is not considered for LDV profiling. +-- closure is not @IND@ or @IND_OLDGEN@ because neither is 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 0ffe6a3ca4..95dfa99389 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -70,7 +70,6 @@ module StgCmmTicky ( withNewTickyCounterLNE, withNewTickyCounterThunk, withNewTickyCounterStdThunk, - withNewTickyCounterCon, tickyDynAlloc, tickyAllocHeap, @@ -144,13 +143,7 @@ import Control.Monad ( unless, when ) -- ----------------------------------------------------------------------------- -data TickyClosureType - = TickyFun - | TickyCon - | TickyThunk - Bool -- True <-> updateable - Bool -- True <-> standard thunk (AP or selector), has no entry counter - | TickyLNE +data TickyClosureType = TickyFun | TickyThunk | TickyLNE withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a withNewTickyCounterFun = withNewTickyCounter TickyFun @@ -159,38 +152,15 @@ withNewTickyCounterLNE nm args code = do b <- tickyLNEIsOn if not b then code else withNewTickyCounter TickyLNE nm args code -withNewTickyCounterThunk - :: Bool -- ^ static - -> Bool -- ^ updateable - -> Name - -> FCode a - -> FCode a -withNewTickyCounterThunk isStatic isUpdatable name code = do +withNewTickyCounterThunk,withNewTickyCounterStdThunk :: + Bool -> Name -> FCode a -> FCode a +withNewTickyCounterThunk isStatic name code = do b <- tickyDynThunkIsOn if isStatic || not b -- ignore static thunks then 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 + else withNewTickyCounter TickyThunk name [] code -withNewTickyCounterCon - :: Name - -> FCode a - -> FCode a -withNewTickyCounterCon name code = do - b <- tickyDynThunkIsOn - if not b - then code - else withNewTickyCounter TickyCon name [] code +withNewTickyCounterStdThunk = withNewTickyCounterThunk -- args does not include the void arguments withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a @@ -214,21 +184,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 if isInternalName name - then n <+> parens (ppr mod_name) <+> ext <+> p - else n <+> ext <+> p + 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?" ; 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 abb77261e5..953f055d57 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: %ld bytes", size * sizeof(W_)); + debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); } #endif break; |