diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2016-03-17 16:33:18 +0100 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2016-03-29 16:51:50 +0200 |
commit | 30b9061317ea7b834339d9458c46bd6b9108d947 (patch) | |
tree | 89c0e485d72ede60b55c24fd891aa7594b70733b /compiler/codeGen/StgCmmBind.hs | |
parent | 85e699729491d3afb921158f905d353c7d40517b (diff) | |
download | haskell-30b9061317ea7b834339d9458c46bd6b9108d947.tar.gz |
Be more explicit about closure types in ticky-ticky-report
The report now distinguishes thunks (in the variants single-entry and
standard thunks), constructors and functions (possibly single-entry).
Forthermore, for standard thunks (AP and selector), do not count an
entry when they are allocated. It is not possible to count their
entries, as their code is shared, but better count nothing than count
the wrong thing.
Diffstat (limited to 'compiler/codeGen/StgCmmBind.hs')
-rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index f34186a8ac..d5a3be98c5 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 @@ -462,7 +464,10 @@ closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details closureCodeBody top_lvl bndr cl_info cc args arity body fv_details = -- Note: args may be [], if all args are Void - withNewTickyCounterFun (closureName cl_info) args $ do { + withNewTickyCounterFun + (closureSingleEntry cl_info) + (closureName cl_info) + args $ do { ; let lf_info = closureLFInfo cl_info |