Commit fd12b167 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Use DynFlags to work out if we are doing ticky ticky profiling

We used to use StaticFlags
parent 84029551
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -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.
......
......@@ -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?
......
......@@ -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 ()
......
......@@ -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
......
......@@ -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
......
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