[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().

1 files changed, 5 insertions, 4 deletions

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 4a0abfcb42..765971f244 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,