Merge branch 'master' of http://darcs.haskell.org/ghc

4 files changed, 72 insertions, 60 deletions

diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index ffaa5eec8b..2f312016c7 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -394,9 +394,8 @@ thunkWrapper closure_info thunk_code = do
         -- Stack and/or heap checks
   ; thunkEntryChecks closure_info $ do
       	{
-          dflags <- getDynFlags
           -- Overwrite with black hole if necessary
-	; whenC (blackHoleOnEntry dflags closure_info && node_points)
+        ; whenC (blackHoleOnEntry closure_info && node_points)
  	        (blackHoleIt closure_info)
 	; setupUpdate closure_info thunk_code }
 		-- setupUpdate *encloses* the thunk_code
@@ -449,13 +448,39 @@ blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 
 emitBlackHoleCode :: Bool -> Code
 emitBlackHoleCode is_single_entry = do
+  dflags <- getDynFlags
+
+  -- Eager blackholing is normally disabled, but can be turned on with
+  -- -feager-blackholing.  When it is on, we replace the info pointer
+  -- of the thunk with stg_EAGER_BLACKHOLE_info on entry.
+  
+  -- If we wanted to do eager blackholing with slop filling, we'd need
+  -- to do it at the *end* of a basic block, otherwise we overwrite
+  -- the free variables in the thunk that we still need.  We have a
+  -- patch for this from Andy Cheadle, but not incorporated yet. --SDM
+  -- [6/2004]
+  --
+  -- Previously, eager blackholing was enabled when ticky-ticky was
+  -- on. But it didn't work, and it wasn't strictly necessary to bring
+  -- back minimal ticky-ticky, so now EAGER_BLACKHOLING is
+  -- unconditionally disabled. -- krc 1/2007
+  
+  -- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
+  -- because emitBlackHoleCode is called from CmmParse.
+
+  let  eager_blackholing =  not opt_SccProfilingOn
+                         && dopt Opt_EagerBlackHoling dflags
+             -- Profiling needs slop filling (to support LDV
+             -- profiling), so currently eager blackholing doesn't
+             -- work with profiling.
+
+  whenC eager_blackholing $ do
     tickyBlackHole (not is_single_entry)
-    let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo)
     stmtsC [
        CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
                 (CmmReg (CmmGlobal CurrentTSO)),
        CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
-       CmmStore (CmmReg nodeReg) bh_info
+       CmmStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo))
      ]
 \end{code}
 
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index c4a6c0c520..04f7acb68c 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -708,27 +708,9 @@ getCallMethod _ name _ (LFLetNoEscape arity) n_args
   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 
 
--- Eager blackholing is normally disabled, but can be turned on with
--- -feager-blackholing.  When it is on, we replace the info pointer of
--- the thunk with stg_EAGER_BLACKHOLE_info on entry.
-
--- If we wanted to do eager blackholing with slop filling,
--- we'd need to do it at the *end* of a basic block, otherwise
--- we overwrite the free variables in the thunk that we still
--- need.  We have a patch for this from Andy Cheadle, but not
--- incorporated yet. --SDM [6/2004]
---
---
--- Previously, eager blackholing was enabled when ticky-ticky
--- was on. But it didn't work, and it wasn't strictly necessary 
--- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING 
--- is unconditionally disabled. -- krc 1/2007
-
--- Static closures are never themselves black-holed.
-
-blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
-blackHoleOnEntry _ ConInfo{} = False
-blackHoleOnEntry dflags cl_info
+blackHoleOnEntry :: ClosureInfo -> Bool
+blackHoleOnEntry ConInfo{} = False
+blackHoleOnEntry cl_info
   | isStaticRep (closureSMRep cl_info)
   = False	-- Never black-hole a static closure
 
@@ -736,18 +718,7 @@ blackHoleOnEntry dflags cl_info
   = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
         LFLetNoEscape _           -> False
-        LFThunk _ no_fvs _updatable _ _
-          | eager_blackholing  -> doingTickyProfiling dflags || not no_fvs
-                  -- the former to catch double entry,
-                  -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
-          | otherwise          -> False
-
-           where eager_blackholing =  not opt_SccProfilingOn
-                                   && dopt Opt_EagerBlackHoling dflags
-                        -- Profiling needs slop filling (to support
-                        -- LDV profiling), so currently eager
-                        -- blackholing doesn't work with profiling.
-
+        LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
         _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isKnownFun :: LambdaFormInfo -> Bool
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index ade0be1a94..f34fdb80be 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -47,6 +47,8 @@ import Constants
 import Outputable
 import FastString
 import Maybes
+import DynFlags
+import StaticFlags
 
 ------------------------------------------------------------------------
 --		Top-level bindings
@@ -475,8 +477,7 @@ thunkCode cl_info fv_details cc node arity body
         ; entryHeapCheck cl_info 0 node' arity [] $ do
         { -- Overwrite with black hole if necessary
           -- but *after* the heap-overflow check
-          dflags <- getDynFlags
-        ; whenC (blackHoleOnEntry dflags cl_info && node_points)
+        ; whenC (blackHoleOnEntry cl_info && node_points)
                 (blackHoleIt cl_info)
 
           -- Push update frame
@@ -503,13 +504,39 @@ blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 
 emitBlackHoleCode :: Bool -> FCode ()
 emitBlackHoleCode is_single_entry = do
-  tickyBlackHole (not is_single_entry)
-  emit (mkStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize) (CmmReg (CmmGlobal CurrentTSO)))
-  emitPrimCall [] MO_WriteBarrier []
-  emit (mkStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
-  where
-    bh_lbl | is_single_entry = mkCmmDataLabel rtsPackageId (fsLit "stg_SE_BLACKHOLE_info")
-	   | otherwise	     = mkCmmDataLabel rtsPackageId (fsLit "stg_BLACKHOLE_info")
+  dflags <- getDynFlags
+
+  -- Eager blackholing is normally disabled, but can be turned on with
+  -- -feager-blackholing.  When it is on, we replace the info pointer
+  -- of the thunk with stg_EAGER_BLACKHOLE_info on entry.
+  
+  -- If we wanted to do eager blackholing with slop filling, we'd need
+  -- to do it at the *end* of a basic block, otherwise we overwrite
+  -- the free variables in the thunk that we still need.  We have a
+  -- patch for this from Andy Cheadle, but not incorporated yet. --SDM
+  -- [6/2004]
+  --
+  -- Previously, eager blackholing was enabled when ticky-ticky was
+  -- on. But it didn't work, and it wasn't strictly necessary to bring
+  -- back minimal ticky-ticky, so now EAGER_BLACKHOLING is
+  -- unconditionally disabled. -- krc 1/2007
+  
+  -- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
+  -- because emitBlackHoleCode is called from CmmParse.
+
+  let  eager_blackholing =  not opt_SccProfilingOn
+                         && dopt Opt_EagerBlackHoling dflags
+             -- Profiling needs slop filling (to support LDV
+             -- profiling), so currently eager blackholing doesn't
+             -- work with profiling.
+
+  whenC eager_blackholing $ do
+    tickyBlackHole (not is_single_entry)
+    emit (mkStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
+                  (CmmReg (CmmGlobal CurrentTSO)))
+    emitPrimCall [] MO_WriteBarrier []
+    emit (mkStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo)))
+
 setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()
 	-- Nota Bene: this function does not change Node (even if it's a CAF),
 	-- so that the cost centre in the original closure can still be
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 300606eb7e..12624ba2b6 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -703,8 +703,8 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
 
 -- Static closures are never themselves black-holed.
 
-blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
-blackHoleOnEntry dflags cl_info
+blackHoleOnEntry :: ClosureInfo -> Bool
+blackHoleOnEntry cl_info
   | isStaticRep (closureSMRep cl_info)
   = False	-- Never black-hole a static closure
 
@@ -712,18 +712,7 @@ blackHoleOnEntry dflags cl_info
   = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
 	LFLetNoEscape 		  -> False
-        LFThunk _ no_fvs _updatable _ _
-          | eager_blackholing  -> doingTickyProfiling dflags || not no_fvs
-                  -- the former to catch double entry,
-                  -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
-          | otherwise          -> False
-
-           where eager_blackholing =  not opt_SccProfilingOn
-                                   && dopt Opt_EagerBlackHoling dflags
-                        -- Profiling needs slop filling (to support
-                        -- LDV profiling), so currently eager
-                        -- blackholing doesn't work with profiling.
-
+        LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
         _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isStaticClosure :: ClosureInfo -> Bool