diff options
| author | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-04-12 00:03:27 +0100 |
|---|---|---|
| committer | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-04-12 11:54:11 +0100 |
| commit | 024df664b600a622cb8189ccf31789688505fc1c (patch) | |
| tree | 9d46289910ba55d4ff633530e442d9f2ac8f9b52 /compiler/codeGen/StgCmmHeap.hs | |
| parent | 6afa7779b9614aea7130238b31f4864616f9205e (diff) | |
| download | haskell-024df664b600a622cb8189ccf31789688505fc1c.tar.gz | |
extended ticky to also track "let"s that are not closures
This includes selector, ap, and constructor thunks. They are still
guarded by the -ticky-dyn-thk flag.
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 |