%
% (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}
-- 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`
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}
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,
-- 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}
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
\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
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}
-----------------------------------------------------------------------------
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
*
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; \
}
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
projects / ghc-hetmet.git / commitdiff