From 79abe0acae28895eeb8a762dcf5867b84982a27c Mon Sep 17 00:00:00 2001 From: simonmar Date: Fri, 23 Nov 2001 11:58:00 +0000 Subject: [PATCH] [project @ 2001-11-23 11:57:59 by simonmar] Fix a long-standing bug in the cost attribution of cost-center stacks. The problem case is this: let z = _scc_ "z" f x in ... z ... previously we were attributing the cost of allocating the closure 'z' to the enclosing cost center stack (CCCS), when it should really be attributed to "z":CCCS. The effects are particularly visible with retainer profiling, because the closure retaining 'f' and 'x' would show up with the wrong CCS attached. To fix this, we need a new form of CCS representation internally: 'PushCC CostCentre CostCentreStack' which subsumes (and therefore replaces) SingletonCCS. SingletonCCS is now represented by 'PushCC cc NoCCS'. The CCS argument to SET_HDR may now be an arbitrary expression, such as PushCostCentre(CCCS,foo_cc), as may be the argument to CCS_ALLOC(). So we combine SET_HDR and CCS_ALLOC into a single macro, SET_HDR_, to avoid repeated calls to PushCostCentre(). --- ghc/compiler/absCSyn/AbsCSyn.lhs | 3 +- ghc/compiler/absCSyn/AbsCUtils.lhs | 2 +- ghc/compiler/absCSyn/Costs.lhs | 4 +- ghc/compiler/absCSyn/PprAbsC.lhs | 9 +++-- ghc/compiler/codeGen/CgHeapery.lhs | 19 +++------ ghc/compiler/nativeGen/AbsCStixGen.lhs | 2 +- ghc/compiler/profiling/CostCentre.lhs | 67 +++++++++++++++++++------------- ghc/includes/StgMacros.h | 19 ++++++--- 8 files changed, 71 insertions(+), 54 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 2a6a827..977027d 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: AbsCSyn.lhs,v 1.39 2001/11/08 12:56:01 simonmar Exp $ +% $Id: AbsCSyn.lhs,v 1.40 2001/11/23 11:58:00 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -115,6 +115,7 @@ stored in a mixed type location.) CAddrMode -- address of the info ptr CAddrMode -- cost centre to place in closure -- CReg CurCostCentre or CC_HDR(R1.p{-Node-}) + Int -- size of closure, for profiling | COpStmt [CAddrMode] -- Results diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index 8e83f7d..2d55bd0 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -370,7 +370,7 @@ flatAbsC stmt@(CAssign dest source) = returnFlt (stmt, AbsCNop) flatAbsC stmt@(CJump target) = returnFlt (stmt, AbsCNop) flatAbsC stmt@(CFallThrough target) = returnFlt (stmt, AbsCNop) flatAbsC stmt@(CReturn target return_info) = returnFlt (stmt, AbsCNop) -flatAbsC stmt@(CInitHdr a b cc) = returnFlt (stmt, AbsCNop) +flatAbsC stmt@(CInitHdr a b cc _) = returnFlt (stmt, AbsCNop) flatAbsC stmt@(COpStmt results op args vol_regs) = returnFlt (stmt, AbsCNop) -- Some statements only make sense at the top level, so we always float diff --git a/ghc/compiler/absCSyn/Costs.lhs b/ghc/compiler/absCSyn/Costs.lhs index 6031787..6ea0485 100644 --- a/ghc/compiler/absCSyn/Costs.lhs +++ b/ghc/compiler/absCSyn/Costs.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: Costs.lhs,v 1.29 2001/05/22 13:43:14 simonpj Exp $ +% $Id: Costs.lhs,v 1.30 2001/11/23 11:58:00 simonmar Exp $ % % Only needed in a GranSim setup -- HWL % --------------------------------------------------------------------------- @@ -167,7 +167,7 @@ costs absC = CCodeBlock _ absC -> costs absC - CInitHdr cl_info reg_rel cost_centre -> initHdrCosts + CInitHdr cl_info reg_rel cost_centre _ -> initHdrCosts {- This is more fancy but superflous: The addr modes are fixed and so the costs are const! diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 4a0abfc..765971f 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -374,15 +374,16 @@ pprAbsC (CCodeBlock lbl abs_C) _ } -pprAbsC (CInitHdr cl_info amode cost_centre) _ +pprAbsC (CInitHdr cl_info amode cost_centre size) _ = hcat [ ptext SLIT("SET_HDR_"), char '(', ppr_amode amode, comma, pprCLabelAddr info_lbl, comma, - if_profiling (pprAmode cost_centre), + if_profiling (pprAmode cost_centre), comma, + if_profiling (int size), pp_paren_semi ] where info_lbl = infoTableLabelFromCI cl_info - + pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _ = case (pprTempAndExternDecls stmt) of { (_, pp_exts) -> vcat [ @@ -1481,7 +1482,7 @@ ppr_decls_AbsC (CSwitch discrim alts deflt) ppr_decls_AbsC (CCodeBlock lbl absC) = ppr_decls_AbsC absC -ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre) +ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre _) -- ToDo: strictly speaking, should chk "cost_centre" amode = labelSeenTE info_lbl `thenTE` \ label_seen -> returnTE (Nothing, diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index 8c55d57..4049930 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.27 2001/11/19 16:34:12 simonpj Exp $ +% $Id: CgHeapery.lhs,v 1.28 2001/11/23 11:58:00 simonmar Exp $ % \section[CgHeapery]{Heap management functions} @@ -476,13 +476,11 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets -- GENERATE THE CODE absC ( mkAbstractCs ( - [ cInitHdr closure_info (hpRel realHp info_offset) use_cc ] + [ CInitHdr closure_info + (CAddr (hpRel realHp info_offset)) + use_cc closure_size ] ++ (map do_move amodes_with_offsets))) `thenC` - -- GENERATE CC PROFILING MESSAGES - costCentresC SLIT("CCS_ALLOC") [blame_cc, mkIntCLit closure_size] - `thenC` - -- BUMP THE VIRTUAL HEAP POINTER setVirtHp (virtHp + closure_size) `thenC` @@ -520,13 +518,6 @@ inPlaceAllocDynClosure closure_info head use_cc amodes_with_offsets in -- GENERATE THE CODE absC ( mkAbstractCs ( - [ CInitHdr closure_info head use_cc ] + [ CInitHdr closure_info head use_cc 0{-no alloc-} ] ++ (map do_move amodes_with_offsets))) - --- Avoid hanging on to anything in the CC field when we're not profiling. - -cInitHdr closure_info amode cc - | opt_SccProfilingOn = CInitHdr closure_info (CAddr amode) cc - | otherwise = CInitHdr closure_info (CAddr amode) (panic "absent cc") - \end{code} diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index c85e6d3..5ee35ab 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -304,7 +304,7 @@ addresses, etc.) \begin{code} - gencode (CInitHdr cl_info reg_rel _) + gencode (CInitHdr cl_info reg_rel _ _) = let lhs = a2stix reg_rel lbl = infoTableLabelFromCI cl_info diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs index 78642e2..85c36be 100644 --- a/ghc/compiler/profiling/CostCentre.lhs +++ b/ghc/compiler/profiling/CostCentre.lhs @@ -12,9 +12,10 @@ module CostCentre ( noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS, noCostCentre, noCCAttached, noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS, + isDerivedFromCurrentCCS, mkUserCC, mkAutoCC, mkAllCafsCC, - mkSingletonCCS, cafifyCC, dupifyCC, + mkSingletonCCS, cafifyCC, dupifyCC, pushCCOnCCS, isCafCC, isDupdCC, isEmptyCC, isCafCCS, isSccCountCostCentre, sccAbleCostCentre, @@ -85,14 +86,17 @@ data CostCentreStack -- accumulate any costs. But we still need -- the placeholder. This CCS is it. - | SingletonCCS CostCentre - -- This is primarily for CAF cost centres, which - -- are attached to top-level thunks right at the - -- end of STG processing, before code generation. - -- Hence, a CAF cost centre never appears as the - -- argument of an _scc_. - -- Also, we generate these singleton CCSs statically - -- as part of code generation. + | PushCC CostCentre CostCentreStack + -- These are used during code generation as the CCSs + -- attached to closures. A PushCC never appears as + -- the argument to an _scc_. + -- + -- The tail (2nd argument) is either NoCCS, indicating + -- a staticly allocated CCS, or CurrentCCS indicating + -- a dynamically created CCS. We only support + -- statically allocated *singleton* CCSs at the + -- moment, for the purposes of initialising the CCS + -- field of a CAF. deriving (Eq, Ord) -- needed for Ord on CLabel \end{code} @@ -169,9 +173,13 @@ isCurrentCCS _ = False isSubsumedCCS SubsumedCCS = True isSubsumedCCS _ = False -isCafCCS (SingletonCCS cc) = isCafCC cc +isCafCCS (PushCC cc NoCCS) = isCafCC cc isCafCCS _ = False +isDerivedFromCurrentCCS CurrentCCS = True +isDerivedFromCurrentCCS (PushCC _ ccs) = isDerivedFromCurrentCCS ccs +isDerivedFromCurrentCCS _ = False + currentOrSubsumedCCS SubsumedCCS = True currentOrSubsumedCCS CurrentCCS = True currentOrSubsumedCCS _ = False @@ -181,14 +189,12 @@ Building cost centres \begin{code} mkUserCC :: UserFS -> Module -> CostCentre - mkUserCC cc_name mod = NormalCC { cc_name = encodeFS cc_name, cc_mod = moduleName mod, cc_is_dupd = OriginalCC, cc_is_caf = NotCafCC {-might be changed-} } mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre - mkAutoCC id mod is_caf = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = moduleName mod, cc_is_dupd = OriginalCC, cc_is_caf = is_caf @@ -196,11 +202,15 @@ mkAutoCC id mod is_caf mkAllCafsCC m = AllCafsCC { cc_mod = moduleName m } + + mkSingletonCCS :: CostCentre -> CostCentreStack -mkSingletonCCS cc = SingletonCCS cc +mkSingletonCCS cc = pushCCOnCCS cc NoCCS -cafifyCC, dupifyCC :: CostCentre -> CostCentre +pushCCOnCCS :: CostCentre -> CostCentreStack -> CostCentreStack +pushCCOnCCS = PushCC +cafifyCC, dupifyCC :: CostCentre -> CostCentre cafifyCC cc@(NormalCC {cc_is_caf = is_caf}) = ASSERT(not_a_caf_already is_caf) cc {cc_is_caf = CafCC} @@ -282,23 +292,28 @@ cmp_caf CafCC NotCafCC = GT ----------------------------------------------------------------------------- Printing Cost Centre Stacks. -There are two ways to print a CCS: +The outputable instance for CostCentreStack prints the CCS as a C +expression. - - for debugging output (i.e. -ddump-whatever), - - as a C label +NOTE: Not all cost centres are suitable for using in a static +initializer. In particular, the PushCC forms where the tail is CCCS +may only be used in inline C code because they expand to a +non-constant C expression. \begin{code} instance Outputable CostCentreStack where - ppr ccs = case ccs of - NoCCS -> ptext SLIT("NO_CCS") - CurrentCCS -> ptext SLIT("CCCS") - OverheadCCS -> ptext SLIT("CCS_OVERHEAD") - DontCareCCS -> ptext SLIT("CCS_DONT_CARE") - SubsumedCCS -> ptext SLIT("CCS_SUBSUMED") - SingletonCCS cc -> ppr cc <> ptext SLIT("_ccs") - + ppr NoCCS = ptext SLIT("NO_CCS") + ppr CurrentCCS = ptext SLIT("CCCS") + ppr OverheadCCS = ptext SLIT("CCS_OVERHEAD") + ppr DontCareCCS = ptext SLIT("CCS_DONT_CARE") + ppr SubsumedCCS = ptext SLIT("CCS_SUBSUMED") + ppr (PushCC cc NoCCS) = ppr cc <> ptext SLIT("_ccs") + ppr (PushCC cc ccs) = ptext SLIT("PushCostCentre") <> + parens (ppr ccs <> comma <> ppr cc) + +-- print the static declaration for a singleton CCS. pprCostCentreStackDecl :: CostCentreStack -> SDoc -pprCostCentreStackDecl ccs@(SingletonCCS cc) +pprCostCentreStackDecl ccs@(PushCC cc NoCCS) = hcat [ ptext SLIT("CCS_DECLARE"), char '(', ppr ccs, comma, -- better be codeStyle ppCostCentreLbl cc, comma, diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index 6bd5887..17c3110 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.42 2001/11/22 14:25:11 simonmar Exp $ + * $Id: StgMacros.h,v 1.43 2001/11/23 11:58:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -670,7 +670,7 @@ extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info; StgSeqFrame *__frame; \ TICK_SEQF_PUSHED(); \ __frame = (StgSeqFrame *)(sp); \ - SET_HDR_(__frame,&stg_seq_frame_info,CCCS); \ + SET_HDR((StgClosure *)__frame,(StgInfoTable *)&stg_seq_frame_info,CCCS);\ __frame->link = Su; \ Su = (StgUpdateFrame *)__frame; \ } @@ -693,11 +693,20 @@ extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info; Closure and Info Macros with casting. We don't want to mess around with casts in the generated C code, so - we use these casting versions of the closure/info tables macros. + we use this casting versions of the closure macro. + + This version of SET_HDR also includes CCS_ALLOC for profiling - the + reason we don't use two separate macros is that the cost centre + field is sometimes a non-simple expression and we want to share its + value between SET_HDR and CCS_ALLOC. -------------------------------------------------------------------------- */ -#define SET_HDR_(c,info,ccs) \ - SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),ccs) +#define SET_HDR_(c,info,ccs,size) \ + { \ + CostCentreStack *tmp = (ccs); \ + SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),tmp); \ + CCS_ALLOC(tmp,size); \ + } /* ----------------------------------------------------------------------------- Saving context for exit from the STG world, and loading up context -- 1.7.10.4