Commit bad5783f authored by nfrisby's avatar nfrisby

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

This reverts commit 024df664.

Of course I gaff on my last day...
parent 202f60a6
......@@ -204,9 +204,8 @@ cgRhs :: Id
-- (see above)
)
cgRhs id (StgRhsCon cc con args)
= withNewTickyCounterThunk (idName id) $
buildDynCon id True cc con args
cgRhs name (StgRhsCon cc con args)
= buildDynCon name cc con args
cgRhs name (StgRhsClosure cc bi fvs upd_flag _srt args body)
= do dflags <- getDynFlags
......@@ -364,7 +363,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 (Just bndr) info_tbl lf_info use_cc blame_cc
; hp_plus_n <- allocDynClosure info_tbl lf_info use_cc blame_cc
(map toVarArg fv_details)
-- RETURN
......@@ -382,9 +381,8 @@ cgRhsStdThunk bndr lf_info payload
; return (id_info, gen_code reg)
}
where
gen_code reg -- AHA! A STANDARD-FORM THUNK
= withNewTickyCounterStdThunk (idName bndr) $
do
gen_code reg
= do -- AHA! A STANDARD-FORM THUNK
{ -- LAY OUT THE OBJECT
mod_name <- getModuleName
; dflags <- getDynFlags
......@@ -399,11 +397,9 @@ 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 (Just bndr) info_tbl lf_info
; hp_plus_n <- allocDynClosure info_tbl lf_info
use_cc blame_cc payload_w_offsets
-- RETURN
......@@ -452,8 +448,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
= ASSERT ( not (isStaticClosure cl_info) )
withNewTickyCounterThunk (closureName cl_info) $
= withNewTickyCounterThunk cl_info $
emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $
\(_, node, _) -> thunkCode cl_info fv_details cc node arity body
where
......@@ -557,7 +552,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
do { tickyEnterThunk cl_info
; enterCostCentreThunk (CmmReg nodeReg)
; let lf_info = closureLFInfo cl_info
; fv_bindings <- mapM bind_fv fv_details
......@@ -722,7 +717,7 @@ link_caf node _is_upd = do
blame_cc = use_cc
tso = CmmReg (CmmGlobal CurrentTSO)
; hp_rel <- allocDynClosureCmm Nothing cafBlackHoleInfoTable mkLFBlackHole
; hp_rel <- allocDynClosureCmm 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,21 +109,19 @@ 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 actually_bound cc con args
buildDynCon binder cc con args
= do dflags <- getDynFlags
buildDynCon' dflags (targetPlatform dflags) binder actually_bound cc con args
buildDynCon' dflags (targetPlatform dflags) binder cc con args
buildDynCon' :: DynFlags
-> Platform
-> Id -> Bool
-> Id
-> CostCentreStack
-> DataCon
-> [StgArg]
......@@ -150,7 +148,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)
......@@ -181,7 +179,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
......@@ -195,7 +193,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
......@@ -210,7 +208,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
, return mkNop) }
-------- buildDynCon': the general case -----------
buildDynCon' dflags _ binder actually_bound ccs con args
buildDynCon' dflags _ binder ccs con args
= do { (id_info, reg) <- rhsIdInfo binder lf_info
; return (id_info, gen_code reg)
}
......@@ -224,10 +222,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args
nonptr_wds = tot_wds - ptr_wds
info_tbl = mkDataConInfoTable dflags con False
ptr_wds nonptr_wds
; let ticky_name | actually_bound = Just binder
| otherwise = Nothing
; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info
; hp_plus_n <- allocDynClosure info_tbl lf_info
use_cc blame_cc args_w_offsets
; return (mkRhsInit dflags reg lf_info hp_plus_n) }
where
......
......@@ -610,11 +610,10 @@ cgConApp con stg_args
| otherwise -- Boxed constructors; allocate and return
= ASSERT( stg_args `lengthIs` dataConRepRepArity con )
do { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con) False
do { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con)
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 (hence the False)
-- 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
; emit =<< fcode_init
; emitReturn [idInfoToAmode idinfo] }
......
......@@ -42,7 +42,6 @@ import Cmm
import CmmUtils
import CostCentre
import IdInfo( CafInfo(..), mayHaveCafRefs )
import Id ( Id )
import Module
import DynFlags
import FastString( mkFastString, fsLit )
......@@ -55,8 +54,7 @@ import Data.Maybe (isJust)
-----------------------------------------------------------
allocDynClosure
:: Maybe Id
-> CmmInfoTable
:: CmmInfoTable
-> LambdaFormInfo
-> CmmExpr -- Cost Centre to stick in the object
-> CmmExpr -- Cost Centre to blame for this alloc
......@@ -68,7 +66,7 @@ allocDynClosure
-> FCode CmmExpr -- returns Hp+n
allocDynClosureCmm
:: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
:: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
-> [(CmmExpr, VirtualHpOffset)]
-> FCode CmmExpr -- returns Hp+n
......@@ -90,19 +88,19 @@ allocDynClosureCmm
-- significant - see test T4801.
allocDynClosure mb_id info_tbl lf_info use_cc _blame_cc args_w_offsets
allocDynClosure 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 mb_id info_tbl lf_info
; allocDynClosureCmm info_tbl lf_info
use_cc _blame_cc (zip cmm_args offsets)
}
allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets
allocDynClosureCmm 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 mb_id rep lf_info
; tickyDynAlloc (toRednCountsLbl $ cit_lbl info_tbl) 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 a -> FCode a
setTickyCtrLabel :: CLabel -> FCode () -> FCode ()
setTickyCtrLabel ticky code = do
info <- getInfoDown
withInfoDown code (info {cgd_ticky = ticky})
......
......@@ -65,9 +65,8 @@ the code generator as well as the RTS because:
module StgCmmTicky (
withNewTickyCounterFun,
withNewTickyCounterLNE,
withNewTickyCounterThunk,
withNewTickyCounterStdThunk,
withNewTickyCounterLNE,
tickyDynAlloc,
tickyAllocHeap,
......@@ -88,8 +87,7 @@ module StgCmmTicky (
tickyEnterViaNode,
tickyEnterFun,
tickyEnterThunk, tickyEnterStdThunk, -- dynamic non-value
-- thunks only
tickyEnterThunk,
tickyEnterLNE,
tickyUpdateBhCaf,
......@@ -143,22 +141,22 @@ import Control.Monad ( when )
data TickyClosureType = TickyFun | TickyThunk | TickyLNE
withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode a -> FCode a
withNewTickyCounterFun, withNewTickyCounterLNE :: Name -> [NonVoid Id] -> FCode () -> FCode ()
withNewTickyCounterFun = withNewTickyCounter TickyFun
withNewTickyCounterLNE nm args code = do
b <- tickyLNEIsOn
if not b then code else withNewTickyCounter TickyLNE nm args code
withNewTickyCounterThunk,withNewTickyCounterStdThunk :: Name -> FCode a -> FCode a
withNewTickyCounterThunk name code = do
withNewTickyCounterThunk :: ClosureInfo -> FCode () -> FCode ()
withNewTickyCounterThunk cl_info code
| isStaticClosure cl_info = code -- static thunks are uninteresting
| otherwise = do
b <- tickyDynThunkIsOn
if not b then code else withNewTickyCounter TickyThunk name [] code
withNewTickyCounterStdThunk = withNewTickyCounterThunk
if not b then code else withNewTickyCounter TickyThunk (closureName cl_info) [] code
-- args does not include the void arguments
withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode () -> FCode ()
withNewTickyCounter cloType name args m = do
lbl <- emitTickyCounter cloType name args
setTickyCtrLabel lbl m
......@@ -224,28 +222,23 @@ tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr")
-- -----------------------------------------------------------------------------
-- Ticky entries
-- 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, tickyEnterStaticCon,
tickyEnterStaticThunk, 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 :: FCode ()
tickyEnterThunk = ifTicky $ do
tickyEnterThunk :: ClosureInfo -> FCode ()
tickyEnterThunk cl_info
| isStaticClosure cl_info = tickyEnterStaticThunk
| otherwise = 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)
......@@ -397,21 +390,20 @@ bad for both space and time).
-- -----------------------------------------------------------------------------
-- Ticky allocation
tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
tickyDynAlloc :: Maybe CLabel -> 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_id rep lf = ifTicky $ getDynFlags >>= \dflags ->
tickyDynAlloc mb_ctr_lbl 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_id of
countSpecific = ifTickyAllocd $ case mb_ctr_lbl of
Nothing -> return ()
Just id -> do
let ctr_lbl = mkRednCountsLabel (idName id)
Just ctr_lbl -> do
registerTickyCtr ctr_lbl
bumpTickyAllocd ctr_lbl bytes
......@@ -422,7 +414,6 @@ tickyDynAlloc mb_id 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