diff options
author | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-05-01 08:45:52 -0500 |
---|---|---|
committer | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-05-02 10:27:50 -0500 |
commit | 11a85cc7ea50d4b7c12ea2cc3c0ce39734dc4217 (patch) | |
tree | bf04983c464496e93c4a855c831f6c839c523bbc /compiler/codeGen/StgCmmHeap.hs | |
parent | ade1ae97ed52c493ec415c1601dace39b64071dd (diff) | |
download | haskell-11a85cc7ea50d4b7c12ea2cc3c0ce39734dc4217.tar.gz |
extended ticky to also track "let"s that are not conventional closures
This includes selector, ap, and constructor thunks. They are still
guarded by the -ticky-dyn-thk flag.
(This is 024df664b600a with a small bug fix.)
Diffstat (limited to 'compiler/codeGen/StgCmmHeap.hs')
-rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 0a817030e5..b8962cedb4 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -42,6 +42,7 @@ import Cmm import CmmUtils import CostCentre import IdInfo( CafInfo(..), mayHaveCafRefs ) +import Id ( Id ) import Module import DynFlags import FastString( mkFastString, fsLit ) @@ -54,7 +55,8 @@ import Data.Maybe (isJust) ----------------------------------------------------------- allocDynClosure - :: CmmInfoTable + :: Maybe Id + -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -- Cost Centre to stick in the object -> CmmExpr -- Cost Centre to blame for this alloc @@ -66,7 +68,7 @@ allocDynClosure -> FCode CmmExpr -- returns Hp+n allocDynClosureCmm - :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr + :: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> FCode CmmExpr -- returns Hp+n @@ -88,19 +90,19 @@ allocDynClosureCmm -- significant - see test T4801. -allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets +allocDynClosure mb_id info_tbl lf_info use_cc _blame_cc args_w_offsets = do { let (args, offsets) = unzip args_w_offsets ; cmm_args <- mapM getArgAmode args -- No void args - ; allocDynClosureCmm info_tbl lf_info + ; allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc (zip cmm_args offsets) } -allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets +allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do { virt_hp <- getVirtHp -- SAY WHAT WE ARE ABOUT TO DO ; let rep = cit_rep info_tbl - ; tickyDynAlloc (toRednCountsLbl $ cit_lbl info_tbl) rep lf_info + ; tickyDynAlloc mb_id rep lf_info ; profDynAlloc rep use_cc -- FIND THE OFFSET OF THE INFO-PTR WORD |