X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FClosureInfo.lhs;h=d819873ca9cbcadbc7be24fd0477245c7517e4a1;hb=fd12b167cd246087858d50ab66840274ef609f79;hp=0620099ac7bbe870aecbd8dd3255647c4dfd165c;hpb=840295515da399bd63d1ad789cda97007c96e93b;p=ghc-hetmet.git 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.