diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 7 | ||||
| -rw-r--r-- | compiler/codeGen/ClosureInfo.lhs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 17 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 2 |
4 files changed, 16 insertions, 12 deletions
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index 4d1ce50099..ea295ec212 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -506,9 +506,10 @@ setupUpdate closure_info code else do tickyPushUpdateFrame dflags <- getDynFlags - if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags - then pushBHUpdateFrame (CmmReg nodeReg) code - else pushUpdateFrame (CmmReg nodeReg) code + if blackHoleOnEntry closure_info && + not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags + then pushBHUpdateFrame (CmmReg nodeReg) code + else pushUpdateFrame (CmmReg nodeReg) code | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index b3a365b201..ac60677bbd 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -731,7 +731,7 @@ blackHoleOnEntry cl_info = case closureLFInfo cl_info of LFReEntrant _ _ _ _ -> False LFLetNoEscape _ -> False - LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks. + LFThunk _ _no_fvs _updatable _ _ -> True _other -> panic "blackHoleOnEntry" -- Should never happen isKnownFun :: LambdaFormInfo -> Bool diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 9bf57b1cb4..3ae25b4652 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -565,12 +565,15 @@ setupUpdate closure_info node body then do tickyUpdateFrameOmitted; body else do tickyPushUpdateFrame - --dflags <- getDynFlags - let es = [CmmReg (CmmLocal node), mkLblExpr mkUpdInfoLabel] - --if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags - -- then pushUpdateFrame es body -- XXX black hole - -- else pushUpdateFrame es body - pushUpdateFrame es body + dflags <- getDynFlags + let + bh = blackHoleOnEntry closure_info && + not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags + + lbl | bh = mkBHUpdInfoLabel + | otherwise = mkUpdInfoLabel + + pushUpdateFrame [CmmReg (CmmLocal node), mkLblExpr lbl] body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -579,7 +582,7 @@ setupUpdate closure_info node body then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf True ; pushUpdateFrame [CmmReg (CmmLocal upd_closure), - mkLblExpr mkUpdInfoLabel] body } -- XXX black hole + mkLblExpr mkBHUpdInfoLabel] body } else do {tickyUpdateFrameOmitted; body} } diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 9185002354..de7ab3d11a 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -728,7 +728,7 @@ blackHoleOnEntry cl_info = case closureLFInfo cl_info of LFReEntrant _ _ _ _ -> False LFLetNoEscape -> False - LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks. + LFThunk _ _no_fvs _updatable _ _ -> True _other -> panic "blackHoleOnEntry" -- Should never happen isStaticClosure :: ClosureInfo -> Bool |