Commit 79abe0ac authored by simonmar's avatar simonmar
Browse files

[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().
parent 7edf3bea
%
% (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
......
......@@ -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
......
%
% (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!
......
......@@ -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,
......
%
% (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}
......@@ -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
......
......@@ -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,
......
/* -----------------------------------------------------------------------------
* $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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment