Add optional eager black-holing, with new flag -feager-blackholing

Eager blackholing can improve parallel performance by reducing the
chances that two threads perform the same computation.  However, it
has a cost: one extra memory write per thunk entry.  

To get the best results, any code which may be executed in parallel
should be compiled with eager blackholing turned on.  But since
there's a cost for sequential code, we make it optional and turn it on
for the parallel package only.  It might be a good idea to compile
applications (or modules) with parallel code in with
-feager-blackholing.

ToDo: document -feager-blackholing.

3 files changed, 18 insertions, 23 deletions

diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 902b975a91..80949e7513 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -50,6 +50,8 @@ import Module
 import ListSetOps
 import Util
 import BasicTypes
+import StaticFlags
+import DynFlags
 import Constants
 import Outputable
 import FastString
@@ -452,15 +454,9 @@ blackHoleIt :: ClosureInfo -> Code
 blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 
 emitBlackHoleCode :: Bool -> Code
-emitBlackHoleCode is_single_entry 
-  | eager_blackholing = do 
-	tickyBlackHole (not is_single_entry)
-	stmtC (CmmStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
-  | otherwise = 
-	nopC
-  where
-    bh_lbl | is_single_entry = mkRtsDataLabel (sLit "stg_SE_BLACKHOLE_info")
-	   | otherwise	     = mkRtsDataLabel (sLit "stg_BLACKHOLE_info")
+emitBlackHoleCode is_single_entry = do
+
+  dflags <- getDynFlags
 
 	-- If we wanted to do eager blackholing with slop filling,
 	-- we'd need to do it at the *end* of a basic block, otherwise
@@ -476,7 +472,16 @@ emitBlackHoleCode is_single_entry
         -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING 
         -- is unconditionally disabled. -- krc 1/2007
 
-    eager_blackholing = False 
+  let eager_blackholing =  not opt_SccProfilingOn
+                        && dopt Opt_EagerBlackHoling dflags
+
+  if eager_blackholing
+     then do
+          tickyBlackHole (not is_single_entry)
+          let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo)
+	  stmtC (CmmStore (CmmReg nodeReg) bh_info)
+     else
+          nopC
 \end{code}
 
 \begin{code}
@@ -571,8 +576,7 @@ link_caf cl_info is_upd = do
   ; returnFC hp_rel }
   where
     bh_cl_info :: ClosureInfo
-    bh_cl_info | is_upd    = cafBlackHoleClosureInfo   cl_info
-	       | otherwise = seCafBlackHoleClosureInfo cl_info
+    bh_cl_info = cafBlackHoleClosureInfo cl_info
 
     ind_static_info :: CmmExpr
     ind_static_info = mkLblExpr mkIndStaticInfoLabel
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 213b9ea4a0..4de3537788 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -542,6 +542,7 @@ baseRegOffset HpLim		  = oFFSET_StgRegTable_rHpLim
 baseRegOffset CurrentTSO	  = oFFSET_StgRegTable_rCurrentTSO
 baseRegOffset CurrentNursery	  = oFFSET_StgRegTable_rCurrentNursery
 baseRegOffset HpAlloc		  = oFFSET_StgRegTable_rHpAlloc
+baseRegOffset EagerBlackholeInfo  = oFFSET_stgEagerBlackholeInfo
 baseRegOffset GCEnter1		  = oFFSET_stgGCEnter1
 baseRegOffset GCFun		  = oFFSET_stgGCFun
 baseRegOffset BaseReg		  = panic "baseRegOffset:BaseReg"
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 07a833f5af..dcb41b4cc4 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -58,7 +58,7 @@ module ClosureInfo (
 	closureValDescr, closureTypeDescr,	-- profiling
 
 	isStaticClosure,
-	cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
+	cafBlackHoleClosureInfo,
 
 	staticClosureNeedsLink,
     ) where
@@ -959,16 +959,6 @@ cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 		  closureType   = ty,
 		  closureDescr  = "" }
 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
-
-seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
-				         closureType = ty })
-  = ClosureInfo { closureName   = nm,
-		  closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
-		  closureSMRep  = BlackHoleRep,
-		  closureSRT    = NoC_SRT,
-		  closureType   = ty,
-		  closureDescr  = ""  }
-seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
 \end{code}
 
 %************************************************************************