From fd12b167cd246087858d50ab66840274ef609f79 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Thu, 18 Dec 2008 16:19:28 +0000 Subject: [PATCH] Use DynFlags to work out if we are doing ticky ticky profiling We used to use StaticFlags --- compiler/codeGen/CgClosure.lhs | 6 ++++-- compiler/codeGen/CgTailCall.lhs | 3 ++- compiler/codeGen/CgTicky.hs | 8 +++++--- compiler/codeGen/ClosureInfo.lhs | 32 +++++++++++++++++--------------- compiler/codeGen/StgCmmBind.hs | 3 ++- compiler/codeGen/StgCmmClosure.hs | 33 +++++++++++++++++---------------- compiler/codeGen/StgCmmExpr.hs | 5 +++-- compiler/codeGen/StgCmmTicky.hs | 9 +++++---- compiler/main/DynFlags.hs | 6 ++++++ compiler/main/StaticFlags.hs | 3 --- 10 files changed, 61 insertions(+), 47 deletions(-) diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index 18879a3..56f2847 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -395,8 +395,10 @@ thunkWrapper closure_info thunk_code = do -- Stack and/or heap checks ; thunkEntryChecks closure_info $ do - { -- Overwrite with black hole if necessary - whenC (blackHoleOnEntry closure_info && node_points) + { + dflags <- getDynFlags + -- Overwrite with black hole if necessary + ; whenC (blackHoleOnEntry dflags closure_info && node_points) (blackHoleIt closure_info) ; setupUpdate closure_info thunk_code } -- setupUpdate *encloses* the thunk_code diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs index 6f8fd04..e4f79a7 100644 --- a/compiler/codeGen/CgTailCall.lhs +++ b/compiler/codeGen/CgTailCall.lhs @@ -108,7 +108,8 @@ performTailCall fun_info arg_amodes pending_assts | otherwise = noStmts ; EndOfBlockInfo sp _ <- getEndOfBlockInfo - ; case (getCallMethod fun_name fun_has_cafs lf_info (length arg_amodes)) of + ; dflags <- getDynFlags + ; case (getCallMethod dflags fun_name fun_has_cafs lf_info (length arg_amodes)) of -- Node must always point to things we enter EnterIt -> do diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 5422127..27af446 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -69,6 +69,8 @@ import PrelNames import TcType import TyCon +import DynFlags + import Data.Maybe ----------------------------------------------------------------------------- @@ -298,9 +300,9 @@ tickyAllocHeap hp -- Ticky utils ifTicky :: Code -> Code -ifTicky code - | opt_DoTickyProfiling = code - | otherwise = nopC +ifTicky code = do dflags <- getDynFlags + if doingTickyProfiling dflags then code + else nopC addToMemLbl :: Width -> CLabel -> Int -> CmmStmt addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 0620099..d819873 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -88,6 +88,7 @@ import BasicTypes import FastString import Outputable import Constants +import DynFlags \end{code} @@ -576,37 +577,38 @@ data CallMethod CLabel -- The code label Int -- Its arity -getCallMethod :: Name -- Function being applied +getCallMethod :: DynFlags + -> Name -- Function being applied -> CafInfo -- Can it refer to CAF's? -> LambdaFormInfo -- Its info -> Int -- Number of available arguments -> CallMethod -getCallMethod name _ lf_info n_args +getCallMethod _ name _ lf_info n_args | nodeMustPointToIt lf_info && opt_Parallel = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been -- fetched since we allocated it. EnterIt -getCallMethod name caf (LFReEntrant _ arity _ _) n_args +getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args | n_args == 0 = ASSERT( arity /= 0 ) ReturnIt -- No args at all | n_args < arity = SlowCall -- Not enough args | otherwise = DirectEntry (enterIdLabel name caf) arity -getCallMethod name _ (LFCon con) n_args +getCallMethod _ name _ (LFCon con) n_args = ASSERT( n_args == 0 ) ReturnCon con -getCallMethod name caf (LFThunk _ _ updatable std_form_info is_fun) n_args +getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args | is_fun -- it *might* be a function, so we must "call" it (which is -- always safe) = SlowCall -- We cannot just enter it [in eval/apply, the entry code -- is the fast-entry code] -- Since is_fun is False, we are *definitely* looking at a data value - | updatable || opt_DoTickyProfiling -- to catch double entry + | updatable || doingTickyProfiling dflags -- to catch double entry {- OLD: || opt_SMP I decided to remove this, because in SMP mode it doesn't matter if we enter the same thunk multiple times, so the optimisation @@ -624,10 +626,10 @@ getCallMethod name caf (LFThunk _ _ updatable std_form_info is_fun) n_args = ASSERT( n_args == 0 ) JumpToIt (thunkEntryLabel name caf std_form_info updatable) -getCallMethod name _ (LFUnknown True) n_args +getCallMethod _ name _ (LFUnknown True) n_args = SlowCall -- Might be a function -getCallMethod name _ (LFUnknown False) n_args +getCallMethod _ name _ (LFUnknown False) n_args | n_args > 0 = WARN( True, ppr name <+> ppr n_args ) SlowCall -- Note [Unsafe coerce complications] @@ -635,27 +637,27 @@ getCallMethod name _ (LFUnknown False) n_args | otherwise = EnterIt -- Not a function -getCallMethod name _ (LFBlackHole _) n_args +getCallMethod _ name _ (LFBlackHole _) n_args = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it -getCallMethod name _ (LFLetNoEscape 0) n_args +getCallMethod _ name _ (LFLetNoEscape 0) n_args = JumpToIt (enterReturnPtLabel (nameUnique name)) -getCallMethod name _ (LFLetNoEscape arity) n_args +getCallMethod _ name _ (LFLetNoEscape arity) n_args | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity) -blackHoleOnEntry :: ClosureInfo -> Bool +blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool -- Static closures are never themselves black-holed. -- Updatable ones will be overwritten with a CAFList cell, which points to a -- black hole; -- Single-entry ones have no fvs to plug, and we trust they don't form part -- of a loop. -blackHoleOnEntry ConInfo{} = False -blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) +blackHoleOnEntry _ ConInfo{} = False +blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) | isStaticRep rep = False -- Never black-hole a static closure @@ -666,7 +668,7 @@ blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) LFThunk _ no_fvs updatable _ _ -> if updatable then not opt_OmitBlackHoling - else opt_DoTickyProfiling || not no_fvs + else doingTickyProfiling dflags || not no_fvs -- the former to catch double entry, -- and the latter to plug space-leaks. KSW/SDM 1999-04. diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index b4415eb..ee033b1 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -462,7 +462,8 @@ thunkCode cl_info fv_details cc node arity body ; entryHeapCheck node arity [] $ do { -- Overwrite with black hole if necessary -- but *after* the heap-overflow check - whenC (blackHoleOnEntry cl_info && node_points) + dflags <- getDynFlags + ; whenC (blackHoleOnEntry dflags cl_info && node_points) (blackHoleIt cl_info) -- Push update frame diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 7e8f02c..d4789be 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -90,7 +90,7 @@ import TyCon import BasicTypes import Outputable import Constants - +import DynFlags ----------------------------------------------------------------------------- -- Representations @@ -491,38 +491,39 @@ data CallMethod CLabel -- The code label Int -- Its arity -getCallMethod :: Name -- Function being applied +getCallMethod :: DynFlags + -> Name -- Function being applied -> CafInfo -- Can it refer to CAF's? -> LambdaFormInfo -- Its info -> Int -- Number of available arguments -> CallMethod -getCallMethod _name _ lf_info _n_args +getCallMethod _ _name _ lf_info _n_args | nodeMustPointToIt lf_info && opt_Parallel = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been -- fetched since we allocated it. EnterIt -getCallMethod name caf (LFReEntrant _ arity _ _) n_args +getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args | n_args == 0 = ASSERT( arity /= 0 ) ReturnIt -- No args at all | n_args < arity = SlowCall -- Not enough args | otherwise = DirectEntry (enterIdLabel name caf) arity -getCallMethod _name _ LFUnLifted n_args +getCallMethod _ _name _ LFUnLifted n_args = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _name _ (LFCon _) n_args +getCallMethod _ _name _ (LFCon _) n_args = ASSERT( n_args == 0 ) ReturnIt -getCallMethod name caf (LFThunk _ _ updatable std_form_info is_fun) n_args +getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args | is_fun -- it *might* be a function, so we must "call" it (which is always safe) = SlowCall -- We cannot just enter it [in eval/apply, the entry code -- is the fast-entry code] -- Since is_fun is False, we are *definitely* looking at a data value - | updatable || opt_DoTickyProfiling -- to catch double entry + | updatable || doingTickyProfiling dflags -- to catch double entry {- OLD: || opt_SMP I decided to remove this, because in SMP mode it doesn't matter if we enter the same thunk multiple times, so the optimisation @@ -540,19 +541,19 @@ getCallMethod name caf (LFThunk _ _ updatable std_form_info is_fun) n_args = ASSERT( n_args == 0 ) DirectEntry (thunkEntryLabel name caf std_form_info updatable) 0 -getCallMethod _name _ (LFUnknown True) _n_args +getCallMethod _ _name _ (LFUnknown True) _n_args = SlowCall -- might be a function -getCallMethod name _ (LFUnknown False) n_args +getCallMethod _ name _ (LFUnknown False) n_args = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) EnterIt -- Not a function -getCallMethod _name _ (LFBlackHole _) _n_args +getCallMethod _ _name _ (LFBlackHole _) _n_args = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it -getCallMethod _name _ LFLetNoEscape _n_args +getCallMethod _ _name _ LFLetNoEscape _n_args = JumpToIt isStandardFormThunk :: LambdaFormInfo -> Bool @@ -887,15 +888,15 @@ minPayloadSize smrep updatable -- Other functions over ClosureInfo -------------------------------------- -blackHoleOnEntry :: ClosureInfo -> Bool +blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool -- Static closures are never themselves black-holed. -- Updatable ones will be overwritten with a CAFList cell, which points to a -- black hole; -- Single-entry ones have no fvs to plug, and we trust they don't form part -- of a loop. -blackHoleOnEntry ConInfo{} = False -blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) +blackHoleOnEntry _ ConInfo{} = False +blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) | isStaticRep rep = False -- Never black-hole a static closure @@ -906,7 +907,7 @@ blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep }) LFThunk _ no_fvs updatable _ _ -> if updatable then not opt_OmitBlackHoling - else opt_DoTickyProfiling || not no_fvs + else doingTickyProfiling dflags || not no_fvs -- the former to catch double entry, -- and the latter to plug space-leaks. KSW/SDM 1999-04. diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 47bf6c4..369564c 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -442,8 +442,9 @@ cgLneJump blk_id lne_regs args -- Join point; discard sequel <*> mkBranch blk_id) } cgTailCall :: Id -> CgIdInfo -> [StgArg] -> FCode () -cgTailCall fun_id fun_info args - = case (getCallMethod fun_name (idCafInfo fun_id) lf_info (length args)) of +cgTailCall fun_id fun_info args = do + dflags <- getDynFlags + case (getCallMethod dflags fun_name (idCafInfo fun_id) lf_info (length args)) of -- A value in WHNF, so we can just return it. ReturnIt -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 544f863..2e4b29e 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -56,12 +56,13 @@ import CLabel import Module import Name import Id -import StaticFlags import BasicTypes import FastString import Constants import Outputable +import DynFlags + -- Turgid imports for showTypeCategory import PrelNames import TcType @@ -321,9 +322,9 @@ tickyAllocHeap hp -- Ticky utils ifTicky :: FCode () -> FCode () -ifTicky code - | opt_DoTickyProfiling = code - | otherwise = nopC +ifTicky code = do dflags <- getDynFlags + if doingTickyProfiling dflags then code + else nopC -- All the ticky-ticky counters are declared "unsigned long" in C bumpTickyCounter :: LitString -> FCode () diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b5cfb23..3f975cd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -35,6 +35,7 @@ module DynFlags ( updOptLevel, setTmpDir, setPackageName, + doingTickyProfiling, -- ** Parsing DynFlags parseDynamicFlags, @@ -517,6 +518,11 @@ isNoLink :: GhcLink -> Bool isNoLink NoLink = True isNoLink _ = False +-- Is it worth evaluating this Bool and caching it in the DynFlags value +-- during initDynFlags? +doingTickyProfiling :: DynFlags -> Bool +doingTickyProfiling dflags = WayTicky `elem` wayNames dflags + data PackageFlag = ExposePackage String | HidePackage String diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 456f620..d88a33d 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -27,7 +27,6 @@ module StaticFlags ( -- profiling opts opt_SccProfilingOn, - opt_DoTickyProfiling, -- Hpc opts opt_Hpc, @@ -196,8 +195,6 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") -- profiling opts opt_SccProfilingOn :: Bool opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling") -opt_DoTickyProfiling :: Bool -opt_DoTickyProfiling = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways) -- Hpc opts opt_Hpc :: Bool -- 1.7.10.4