summaryrefslogtreecommitdiff
path: root/compiler/codeGen/ClosureInfo.lhs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2008-12-18 16:19:28 +0000
committerIan Lynagh <igloo@earth.li>2008-12-18 16:19:28 +0000
commitfd12b167cd246087858d50ab66840274ef609f79 (patch)
tree8558630ebdc5d2a1d35c1c9f2cefa324639d8f5b /compiler/codeGen/ClosureInfo.lhs
parent840295515da399bd63d1ad789cda97007c96e93b (diff)
downloadhaskell-fd12b167cd246087858d50ab66840274ef609f79.tar.gz
Use DynFlags to work out if we are doing ticky ticky profiling
We used to use StaticFlags
Diffstat (limited to 'compiler/codeGen/ClosureInfo.lhs')
-rw-r--r--compiler/codeGen/ClosureInfo.lhs32
1 files changed, 17 insertions, 15 deletions
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 0620099ac7..d819873ca9 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.