Commit 11a85cc7 authored by nfrisby's avatar nfrisby

extended ticky to also track "let"s that are not conventional closures

This includes selector, ap, and constructor thunks. They are still
guarded by the -ticky-dyn-thk flag.

(This is 024df664 with a small bug fix.)
parent ade1ae97
......@@ -204,8 +204,9 @@ cgRhs :: Id
-- (see above)
)
cgRhs name (StgRhsCon cc con args)
= buildDynCon name cc con args
cgRhs id (StgRhsCon cc con args)
= withNewTickyCounterThunk False (idName id) $ -- False for "not static"
buildDynCon id True cc con args
cgRhs name (StgRhsClosure cc bi fvs upd_flag _srt args body)
= do dflags <- getDynFlags
......@@ -363,7 +364,7 @@ mkRhsClosure _ bndr cc _ fvs upd_flag args body
; emit (mkComment $ mkFastString "calling allocDynClosure")
; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
; let info_tbl = mkCmmInfo closure_info
; hp_plus_n <- allocDynClosure info_tbl lf_info use_cc blame_cc
; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc
(map toVarArg fv_details)
-- RETURN
......@@ -381,8 +382,9 @@ cgRhsStdThunk bndr lf_info payload
; return (id_info, gen_code reg)
}
where
gen_code reg
= do -- AHA! A STANDARD-FORM THUNK
gen_code reg -- AHA! A STANDARD-FORM THUNK
= withNewTickyCounterStdThunk False (idName bndr) $ -- False for "not static"
do
{ -- LAY OUT THE OBJECT
mod_name <- getModuleName
; dflags <- getDynFlags
......@@ -397,9 +399,11 @@ cgRhsStdThunk bndr lf_info payload
-- ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
; let use_cc = curCCS; blame_cc = curCCS
; tickyEnterStdThunk
-- BUILD THE OBJECT
; let info_tbl = mkCmmInfo closure_info
; hp_plus_n <- allocDynClosure info_tbl lf_info
; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info
use_cc blame_cc payload_w_offsets
-- RETURN
......@@ -448,7 +452,7 @@ closureCodeBody :: Bool -- whether this is a top-level binding
closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
| arity == 0 -- No args i.e. thunk
= withNewTickyCounterThunk cl_info $
= withNewTickyCounterThunk (isStaticClosure cl_info) (closureName cl_info) $
emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
\(_, node, _) -> thunkCode cl_info fv_details cc node arity body
where
......@@ -552,7 +556,7 @@ thunkCode cl_info fv_details _cc node arity body
-- that cc of enclosing scope will be recorded
-- in update frame CAF/DICT functions will be
-- subsumed by this enclosing cc
do { tickyEnterThunk cl_info
do { tickyEnterThunk
; enterCostCentreThunk (CmmReg nodeReg)
; let lf_info = closureLFInfo cl_info
; fv_bindings <- mapM bind_fv fv_details
......@@ -717,7 +721,7 @@ link_caf node _is_upd = do
blame_cc = use_cc
tso = CmmReg (CmmGlobal CurrentTSO)
; hp_rel <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole
; hp_rel <- allocDynClosureCmm Nothing cafBlackHoleInfoTable mkLFBlackHole
use_cc blame_cc [(tso,fixedHdrSize dflags)]
-- small optimisation: we duplicate the hp_rel expression in
-- both the newCAF call and the value returned below.
......
......@@ -109,19 +109,21 @@ cgTopRhsCon id con args
buildDynCon :: Id -- Name of the thing to which this constr will
-- be bound
-> Bool -- is it genuinely bound to that name, or just for profiling?
-> CostCentreStack -- Where to grab cost centre from;
-- current CCS if currentOrSubsumedCCS
-> DataCon -- The data constructor
-> [StgArg] -- Its args
-> FCode (CgIdInfo, FCode CmmAGraph)
-- Return details about how to find it and initialization code
buildDynCon binder cc con args
buildDynCon binder actually_bound cc con args
= do dflags <- getDynFlags
buildDynCon' dflags (targetPlatform dflags) binder cc con args
buildDynCon' dflags (targetPlatform dflags) binder actually_bound cc con args
buildDynCon' :: DynFlags
-> Platform
-> Id
-> Id -> Bool
-> CostCentreStack
-> DataCon
-> [StgArg]
......@@ -148,7 +150,7 @@ premature looking at the args will cause the compiler to black-hole!
-- which have exclusively size-zero (VoidRep) args, we generate no code
-- at all.
buildDynCon' dflags _ binder _cc con []
buildDynCon' dflags _ binder _ _cc con []
= return (litIdInfo dflags binder (mkConLFInfo con)
(CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))),
return mkNop)
......@@ -179,7 +181,7 @@ We don't support this optimisation when compiling into Windows DLLs yet
because they don't support cross package data references well.
-}
buildDynCon' dflags platform binder _cc con [arg]
buildDynCon' dflags platform binder _ _cc con [arg]
| maybeIntLikeCon con
, platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags)
, StgLitArg (MachInt val) <- arg
......@@ -193,7 +195,7 @@ buildDynCon' dflags platform binder _cc con [arg]
; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode
, return mkNop) }
buildDynCon' dflags platform binder _cc con [arg]
buildDynCon' dflags platform binder _ _cc con [arg]
| maybeCharLikeCon con
, platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags)
, StgLitArg (MachChar val) <- arg
......@@ -208,7 +210,7 @@ buildDynCon' dflags platform binder _cc con [arg]
, return mkNop) }
-------- buildDynCon': the general case -----------
buildDynCon' dflags _ binder ccs con args
buildDynCon' dflags _ binder actually_bound ccs con args
= do { (id_info, reg) <- rhsIdInfo binder lf_info
; return (id_info, gen_code reg)
}
......@@ -222,7 +224,10 @@ buildDynCon' dflags _ binder ccs con args
nonptr_wds = tot_wds - ptr_wds
info_tbl = mkDataConInfoTable dflags con False
ptr_wds nonptr_wds
; hp_plus_n <- allocDynClosure info_tbl lf_info
; let ticky_name | actually_bound = Just binder
| otherwise = Nothing
; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info
use_cc blame_cc args_w_offsets
; return (mkRhsInit dflags reg lf_info hp_plus_n) }
where
......
......@@ -610,10 +610,11 @@ cgConApp con stg_args
| otherwise -- Boxed constructors; allocate and return
= ASSERT( stg_args `lengthIs` dataConRepRepArity con )
do { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con)
do { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con) False
currentCCS con stg_args
-- The first "con" says that the name bound to this closure is
-- is "con", which is a bit of a fudge, but it only affects profiling
-- The first "con" says that the name bound to this
-- closure is is "con", which is a bit of a fudge, but
-- it only affects profiling (hence the False)
; emit =<< fcode_init
; emitReturn [idInfoToAmode idinfo] }
......
......@@ -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
......
......@@ -514,7 +514,7 @@ getTickyCtrLabel = do
info <- getInfoDown
return (cgd_ticky info)
setTickyCtrLabel :: CLabel -> FCode () -> FCode ()
setTickyCtrLabel :: CLabel -> FCode a -> FCode a
setTickyCtrLabel ticky code = do
info <- getInfoDown
withInfoDown code (info {cgd_ticky = ticky})
......
......@@ -65,8 +65,9 @@ the code generator as well as the RTS because:
module StgCmmTicky (
withNewTickyCounterFun,
withNewTickyCounterThunk,
withNewTickyCounterLNE,
withNewTickyCounterThunk,
withNewTickyCounterStdThunk,
tickyDynAlloc,
tickyAllocHeap,
......@@ -87,7 +88,8 @@ module StgCmmTicky (
tickyEnterViaNode,
tickyEnterFun,
tickyEnterThunk,
tickyEnterThunk, tickyEnterStdThunk, -- dynamic non-value
-- thunks only
tickyEnterLNE,
tickyUpdateBhCaf,
......@@ -141,22 +143,25 @@ import Control.Monad ( when )
data TickyClosureType = TickyFun | TickyThunk | TickyLNE
withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode () -> FCode ()
withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a
withNewTickyCounterFun = withNewTickyCounter TickyFun
withNewTickyCounterLNE nm args code = do
b <- tickyLNEIsOn
if not b then code else withNewTickyCounter TickyLNE nm args code
withNewTickyCounterThunk :: ClosureInfo -> FCode () -> FCode ()
withNewTickyCounterThunk cl_info code
| isStaticClosure cl_info = code -- static thunks are uninteresting
| otherwise = do
withNewTickyCounterThunk,withNewTickyCounterStdThunk ::
Bool -> Name -> FCode a -> FCode a
withNewTickyCounterThunk isStatic name code = do
b <- tickyDynThunkIsOn
if not b then code else withNewTickyCounter TickyThunk (closureName cl_info) [] code
if isStatic || not b -- ignore static thunks
then code
else withNewTickyCounter TickyThunk name [] code
withNewTickyCounterStdThunk = withNewTickyCounterThunk
-- args does not include the void arguments
withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode () -> FCode ()
withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
withNewTickyCounter cloType name args m = do
lbl <- emitTickyCounter cloType name args
setTickyCtrLabel lbl m
......@@ -222,23 +227,28 @@ tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr")
-- -----------------------------------------------------------------------------
-- Ticky entries
tickyEnterDynCon, tickyEnterStaticCon,
tickyEnterStaticThunk, tickyEnterViaNode :: FCode ()
-- NB the name-specific entries are only available for names that have
-- dedicated Cmm code. As far as I know, this just rules out
-- constructor thunks. For them, there is no CMM code block to put the
-- bump of name-specific ticky counter into. On the other hand, we can
-- still track allocation their allocation.
tickyEnterDynCon, tickyEnterStaticCon, tickyEnterViaNode :: FCode ()
tickyEnterDynCon = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_CON_ctr")
tickyEnterStaticCon = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_CON_ctr")
tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_THK_ctr")
tickyEnterViaNode = ifTicky $ bumpTickyCounter (fsLit "ENT_VIA_NODE_ctr")
tickyEnterThunk :: ClosureInfo -> FCode ()
tickyEnterThunk cl_info
| isStaticClosure cl_info = tickyEnterStaticThunk
| otherwise = ifTicky $ do
tickyEnterThunk :: FCode ()
tickyEnterThunk = ifTicky $ do
bumpTickyCounter (fsLit "ENT_DYN_THK_ctr")
ifTickyDynThunk $ do
ticky_ctr_lbl <- getTickyCtrLabel
registerTickyCtrAtEntryDyn ticky_ctr_lbl
bumpTickyEntryCount ticky_ctr_lbl
tickyEnterStdThunk :: FCode ()
tickyEnterStdThunk = tickyEnterThunk
tickyBlackHole :: Bool{-updatable-} -> FCode ()
tickyBlackHole updatable
= ifTicky (bumpTickyCounter ctr)
......@@ -390,20 +400,21 @@ bad for both space and time).
-- -----------------------------------------------------------------------------
-- Ticky allocation
tickyDynAlloc :: Maybe CLabel -> SMRep -> LambdaFormInfo -> FCode ()
tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
-- Called when doing a dynamic heap allocation; the LambdaFormInfo
-- used to distinguish between closure types
--
-- TODO what else to count while we're here?
tickyDynAlloc mb_ctr_lbl rep lf = ifTicky $ getDynFlags >>= \dflags ->
tickyDynAlloc mb_id rep lf = ifTicky $ getDynFlags >>= \dflags ->
let bytes = wORD_SIZE dflags * heapClosureSize dflags rep
countGlobal tot ctr = do
bumpTickyCounterBy tot bytes
bumpTickyCounter ctr
countSpecific = ifTickyAllocd $ case mb_ctr_lbl of
countSpecific = ifTickyAllocd $ case mb_id of
Nothing -> return ()
Just ctr_lbl -> do
Just id -> do
let ctr_lbl = mkRednCountsLabel (idName id)
registerTickyCtr ctr_lbl
bumpTickyAllocd ctr_lbl bytes
......@@ -414,6 +425,7 @@ tickyDynAlloc mb_ctr_lbl rep lf = ifTicky $ getDynFlags >>= \dflags ->
in case () of
_ | isConRep rep ->
ifTickyDynThunk countSpecific >>
countGlobal (fsLit "ALLOC_CON_gds") (fsLit "ALLOC_CON_ctr")
| isThunkRep rep ->
ifTickyDynThunk countSpecific >>
......
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