Commit f08d6316 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function

SCC profiling was enabled in a convoluted way: if WayProf was enabled,
Opt_SccProfilingOn general flag was set (in
`GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in
various places.

There is no need to go via general flags, so this patch defines a
`sccProfilingEnabled :: DynFlags -> Bool` helper function that just
checks whether WayProf is enabled.
parent 4d90b3ff
Pipeline #21774 failed with stages
in 851 minutes and 41 seconds
......@@ -605,10 +605,12 @@ setSessionDynFlags dflags = do
then do
let
prog = pgm_i dflags ++ flavour
profiled = ways dflags `hasWay` WayProf
dynamic = ways dflags `hasWay` WayDyn
flavour
| WayProf `S.member` ways dflags = "-prof"
| WayDyn `S.member` ways dflags = "-dyn"
| otherwise = ""
| profiled = "-prof" -- FIXME: can't we have both?
| dynamic = "-dyn"
| otherwise = ""
msg = text "Starting " <> text prog
tr <- if verbosity dflags >= 3
then return (logInfo dflags $ withPprStyle defaultDumpStyle msg)
......@@ -617,8 +619,8 @@ setSessionDynFlags dflags = do
conf = IServConfig
{ iservConfProgram = prog
, iservConfOpts = getOpts dflags opt_i
, iservConfProfiled = gopt Opt_SccProfilingOn dflags
, iservConfDynamic = WayDyn `S.member` ways dflags
, iservConfProfiled = profiled
, iservConfDynamic = dynamic
, iservConfHook = createIservProcessHook (hooks dflags)
, iservConfTrace = tr
}
......
......@@ -405,7 +405,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt layout_lit
where
platform = targetPlatform dflags
prof_info
| gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
| sccProfilingEnabled dflags = [type_descr, closure_descr]
| otherwise = []
tag = CmmInt (fromIntegral cl_type) (halfWordWidth platform)
......@@ -565,7 +565,7 @@ stdInfoTableSizeW :: DynFlags -> WordOff
-- It must vary in sync with mkStdInfoTable
stdInfoTableSizeW dflags
= fixedInfoTableSizeW
+ if gopt Opt_SccProfilingOn dflags
+ if sccProfilingEnabled dflags
then profInfoTableSizeW
else 0
......
......@@ -1168,7 +1168,7 @@ reserveStackFrame psize preg body = do
withUpdFrameOff frame body
profilingInfo dflags desc_str ty_str
= if not (gopt Opt_SccProfilingOn dflags)
= if not (sccProfilingEnabled dflags)
then NoProfilingInfo
else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
......
......@@ -275,11 +275,9 @@ outputForeignStubs_help fname doc_str header footer
-- module;
-- | Generate code to initialise cost centres
profilingInitCode :: DynFlags -> Module -> CollectedCCs -> SDoc
profilingInitCode dflags this_mod (local_CCs, singleton_CCSs)
= if not (gopt Opt_SccProfilingOn dflags)
then empty
else vcat
profilingInitCode :: Module -> CollectedCCs -> SDoc
profilingInitCode this_mod (local_CCs, singleton_CCSs)
= vcat
$ map emit_cc_decl local_CCs
++ map emit_ccs_decl singleton_CCSs
++ [emit_cc_list local_CCs]
......
......@@ -252,7 +252,6 @@ data GeneralFlag
| Opt_PIE -- ^ @-fPIE@
| Opt_PICExecutable -- ^ @-pie@
| Opt_ExternalDynamicRefs
| Opt_SccProfilingOn
| Opt_Ticky
| Opt_Ticky_Allocd
| Opt_Ticky_LNE
......
......@@ -1412,7 +1412,9 @@ hscGenHardCode hsc_env cgguts location output_filename = do
let cost_centre_info =
(S.toList local_ccs ++ caf_ccs, caf_cc_stacks)
prof_init = profilingInitCode dflags this_mod cost_centre_info
prof_init
| sccProfilingEnabled dflags = profilingInitCode this_mod cost_centre_info
| otherwise = empty
foreign_stubs = foreign_stubs0 `appendStubC` prof_init
------------------ Code generation ------------------
......
......@@ -42,6 +42,7 @@ module GHC.Driver.Session (
whenCannotGenerateDynamicToo,
dynamicTooMkDynamicDynFlags,
dynamicOutputFile,
sccProfilingEnabled,
DynFlags(..),
FlagSpec(..),
HasDynFlags(..), ContainsDynFlags(..),
......@@ -5094,6 +5095,10 @@ isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
ArchX86 -> bmiVersion dflags >= Just BMI2
_ -> False
-- | Indicate if cost-centre profiling is enabled
sccProfilingEnabled :: DynFlags -> Bool
sccProfilingEnabled dflags = ways dflags `hasWay` WayProf
-- -----------------------------------------------------------------------------
-- Linker/compiler information
......
......@@ -20,6 +20,7 @@
-- this compilation.
module GHC.Driver.Ways
( Way(..)
, hasWay
, allowed_combination
, wayGeneralFlags
, wayUnsetGeneralFlags
......@@ -60,12 +61,15 @@ data Way
| WayDyn -- ^ Dynamic linking
deriving (Eq, Ord, Show)
-- | Test if a ways is enabled
hasWay :: Set Way -> Way -> Bool
hasWay ws w = Set.member w ws
-- | Check if a combination of ways is allowed
allowed_combination :: Set Way -> Bool
allowed_combination ways = not disallowed
where
disallowed = or [ Set.member ways x && Set.member ways y
disallowed = or [ hasWay ways x && hasWay ways y
| (x,y) <- couples
]
-- List of disallowed couples of ways
......@@ -121,7 +125,7 @@ wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
-- .so before loading the .so using the system linker. Since only
-- PIC objects can be linked into a .so, we have to compile even
-- modules of the main program with -fPIC when using -dynamic.
wayGeneralFlags _ WayProf = [Opt_SccProfilingOn]
wayGeneralFlags _ WayProf = []
wayGeneralFlags _ WayEventLog = []
-- | Turn these flags off when enabling this way
......
......@@ -1040,7 +1040,7 @@ coveragePasses :: DynFlags -> [TickishType]
coveragePasses dflags =
ifa (breakpointsEnabled dflags) Breakpoints $
ifa (gopt Opt_Hpc dflags) HpcTicks $
ifa (gopt Opt_SccProfilingOn dflags &&
ifa (sccProfilingEnabled dflags &&
profAuto dflags /= NoProfAuto) ProfNotes $
ifa (debugLevel dflags > 0) SourceNotes []
where ifa f x xs | f = x:xs
......
......@@ -813,7 +813,7 @@ dsExpr (HsRecFld {}) = panic "dsExpr:HsRecFld"
ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
ds_prag_expr (HsPragSCC _ _ cc) expr = do
dflags <- getDynFlags
if gopt Opt_SccProfilingOn dflags
if sccProfilingEnabled dflags
then do
mod_name <- getModule
count <- goptM Opt_ProfCountEntries
......
......@@ -55,7 +55,7 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
paths = [ hcSuf ]
-- -fprof-auto etc.
prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0
prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0
-- Ticky
ticky =
......
......@@ -282,8 +282,8 @@ fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
-- (StgProfHeader in includes\/rts\/storage\/Closures.h)
profHdrSize :: DynFlags -> WordOff
profHdrSize dflags
| gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
| otherwise = 0
| sccProfilingEnabled dflags = pROF_HDR_SIZE dflags
| otherwise = 0
-- | The garbage collector requires that every closure is at least as
-- big as this.
......
......@@ -805,7 +805,7 @@ pprStgRhs :: OutputablePass pass => GenStgRhs pass -> SDoc
pprStgRhs (StgRhsClosure ext cc upd_flag args body)
= sdocWithDynFlags $ \dflags ->
hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
hang (hsep [if sccProfilingEnabled dflags then ppr cc else empty,
ppUnlessOption sdocSuppressStgExts (ppr ext),
char '\\' <> ppr upd_flag, brackets (interppSP args)])
4 (ppr body)
......
......@@ -307,7 +307,7 @@ mkRhsClosure dflags bndr _cc
, all (isGcPtrRep . idPrimRep . fromNonVoid) fvs
, isUpdatable upd_flag
, n_fvs <= mAX_SPEC_AP_SIZE dflags
, not (gopt Opt_SccProfilingOn dflags)
, not (sccProfilingEnabled dflags)
-- not when profiling: we don't want to
-- lose information about this particular
-- thunk (e.g. its type) (#949)
......@@ -626,7 +626,7 @@ emitBlackHoleCode node = do
-- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
-- because emitBlackHoleCode is called from GHC.Cmm.Parser.
let eager_blackholing = not (gopt Opt_SccProfilingOn dflags)
let eager_blackholing = not (sccProfilingEnabled dflags)
&& gopt Opt_EagerBlackHoling dflags
-- Profiling needs slop filling (to support LDV
-- profiling), so currently eager blackholing doesn't
......@@ -655,7 +655,7 @@ setupUpdate closure_info node body
dflags <- getDynFlags
let
bh = blackHoleOnEntry closure_info &&
not (gopt Opt_SccProfilingOn dflags) &&
not (sccProfilingEnabled dflags) &&
gopt Opt_EagerBlackHoling dflags
lbl | bh = mkBHUpdInfoLabel
......
......@@ -381,7 +381,7 @@ nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _)
= not no_fvs -- Self parameter
|| isNotTopLevel top -- Note [GC recovery]
|| updatable -- Need to push update frame
|| gopt Opt_SccProfilingOn dflags
|| sccProfilingEnabled dflags
-- For the non-updatable (single-entry case):
--
-- True if has fvs (in which case we need access to them, and we
......@@ -508,7 +508,7 @@ getCallMethod dflags _ id _ n_args v_args _cg_loc
getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
_self_loop_info
| n_args == 0 -- No args at all
&& not (gopt Opt_SccProfilingOn dflags)
&& not (sccProfilingEnabled dflags)
-- See Note [Evaluating functions with profiling] in rts/Apply.cmm
= ASSERT( arity /= 0 ) ReturnIt
| n_args < arity = SlowCall -- Not enough args
......@@ -859,7 +859,7 @@ enterIdLabel platform id c
mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
mkProfilingInfo dflags id val_descr
| not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
| not (sccProfilingEnabled dflags) = NoProfilingInfo
| otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
where
ty_descr_w8 = BS8.pack (getTyDescription (idType id))
......@@ -906,8 +906,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
-- We keep the *zero-indexed* tag in the srt_len field
-- of the info table of a data constructor.
prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
| otherwise = ProfilingInfo ty_descr val_descr
prof | not (sccProfilingEnabled dflags) = NoProfilingInfo
| otherwise = ProfilingInfo ty_descr val_descr
ty_descr = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
val_descr = BS8.pack $ occNameString $ getOccName data_con
......
......@@ -306,7 +306,7 @@ saveThreadState dflags = do
spExpr,
close_nursery,
-- and save the current cost centre stack in the TSO when profiling:
if gopt Opt_SccProfilingOn dflags then
if sccProfilingEnabled dflags then
mkStore (cmmOffset platform (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) cccsExpr
else mkNop
]
......@@ -421,7 +421,7 @@ loadThreadState dflags = do
mkAssign hpAllocReg (zeroExpr platform),
open_nursery,
-- and load the current cost centre stack from the TSO when profiling:
if gopt Opt_SccProfilingOn dflags
if sccProfilingEnabled dflags
then storeCurCCS
(CmmLoad (cmmOffset platform (CmmReg (CmmLocal tso))
(tso_CCCS dflags)) (ccsType platform))
......
......@@ -367,7 +367,7 @@ just more arguments that we are passing on the stack (cml_args).
slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs _ [] = []
slowArgs dflags args -- careful: reps contains voids (V), but args does not
| gopt Opt_SccProfilingOn dflags
| sccProfilingEnabled dflags
= save_cccs ++ this_pat ++ slowArgs dflags rest_args
| otherwise = this_pat ++ slowArgs dflags rest_args
where
......
......@@ -300,8 +300,8 @@ emitPrimOp dflags = \case
GetCCSOfOp -> \[arg] -> opAllDone $ \[res] -> do
let
val
| gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
| otherwise = CmmLit (zeroCLit platform)
| sccProfilingEnabled dflags = costCentreFrom dflags (cmmUntag dflags arg)
| otherwise = CmmLit (zeroCLit platform)
emitAssign (CmmLocal res) val
GetCurrentCCSOp -> \[_] -> opAllDone $ \[res] -> do
......
......@@ -76,15 +76,15 @@ costCentreFrom dflags cl = CmmLoad (cmmOffsetB platform cl (oFFSET_StgHeader_ccs
-- | The profiling header words in a static closure
staticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]
staticProfHdr dflags ccs
| gopt Opt_SccProfilingOn dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
| otherwise = []
| sccProfilingEnabled dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
| otherwise = []
where platform = targetPlatform dflags
-- | Profiling header words in a dynamic closure
dynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]
dynProfHdr dflags ccs
| gopt Opt_SccProfilingOn dflags = [ccs, dynLdvInit dflags]
| otherwise = []
| sccProfilingEnabled dflags = [ccs, dynLdvInit dflags]
| otherwise = []
-- | Initialise the profiling field of an update frame
initUpdFrameProf :: CmmExpr -> FCode ()
......@@ -130,7 +130,7 @@ saveCurrentCostCentre :: FCode (Maybe LocalReg)
saveCurrentCostCentre
= do dflags <- getDynFlags
platform <- getPlatform
if not (gopt Opt_SccProfilingOn dflags)
if not (sccProfilingEnabled dflags)
then return Nothing
else do local_cc <- newTemp (ccType platform)
emitAssign (CmmLocal local_cc) cccsExpr
......@@ -195,7 +195,7 @@ enterCostCentreFun ccs closure =
ifProfiling :: FCode () -> FCode ()
ifProfiling code
= do dflags <- getDynFlags
if gopt Opt_SccProfilingOn dflags
if sccProfilingEnabled dflags
then code
else return ()
......@@ -207,7 +207,7 @@ initCostCentres :: CollectedCCs -> FCode ()
-- Emit the declarations
initCostCentres (local_CCs, singleton_CCSs)
= do dflags <- getDynFlags
when (gopt Opt_SccProfilingOn dflags) $
when (sccProfilingEnabled dflags) $
do mapM_ emitCostCentreDecl local_CCs
mapM_ emitCostCentreStackDecl singleton_CCSs
......@@ -277,7 +277,7 @@ emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
emitSetCCC cc tick push
= do dflags <- getDynFlags
platform <- getPlatform
if not (gopt Opt_SccProfilingOn dflags)
if not (sccProfilingEnabled dflags)
then return ()
else do tmp <- newTemp (ccsType platform)
pushCostCentre tmp cccsExpr cc
......
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