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.

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 0c3c007..1c33824 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -63,7 +63,6 @@ module CLabel (
 
        mkTopTickyCtrLabel,
         mkCAFBlackHoleInfoTableLabel,
-        mkSECAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
        mkRtsSlowTickyCtrLabel,
 
@@ -348,10 +347,6 @@ mkEMPTY_MVAR_infoLabel             = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
 
 mkTopTickyCtrLabel             = RtsLabel (RtsData (sLit "top_ct"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
-mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
-                                    RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
-                                  else  -- RTS won't have info table unless -ticky is on
-                                    panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
 
 moduleRegdLabel                        = ModuleRegdLabel

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 06149b4..69a4952 100644 (file)
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -267,6 +267,7 @@ data GlobalReg
                -- We keep the address of some commonly-called 
                -- functions in the register table, to keep code
                -- size down:
+  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
   | GCEnter1           -- stg_gc_enter_1
   | GCFun              -- stg_gc_fun
 

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 37359ed..2a01217 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -748,6 +748,7 @@ pprGlobalReg gr = case gr of
     CurrentNursery -> ptext (sLit "CurrentNursery")
     HpAlloc        -> ptext (sLit "HpAlloc")
     BaseReg        -> ptext (sLit "BaseReg")
+    EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
     GCEnter1       -> ptext (sLit "stg_gc_enter_1")
     GCFun          -> ptext (sLit "stg_gc_fun")
 

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index dbfd20e..e801aee 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -565,6 +565,7 @@ pprGlobalReg gr
         CurrentTSO     -> ptext (sLit "CurrentTSO")
         CurrentNursery -> ptext (sLit "CurrentNursery")
         HpAlloc        -> ptext (sLit "HpAlloc")
+        EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
         GCEnter1       -> ptext (sLit "stg_gc_enter_1")
         GCFun          -> ptext (sLit "stg_gc_fun")
         BaseReg        -> ptext (sLit "BaseReg")

diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 902b975..80949e7 100644 (file)
--- 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 213b9ea..4de3537 100644 (file)
--- 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 07a833f..dcb41b4 100644 (file)
--- 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}
 
 %************************************************************************

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 9c25251..ded2443 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -275,6 +275,7 @@ data DynFlag
    | Opt_DryRun
    | Opt_DoAsmMangling
    | Opt_ExcessPrecision
+   | Opt_EagerBlackHoling
    | Opt_ReadUserPackageConf
    | Opt_NoHsMain
    | Opt_SplitObjs
@@ -1587,6 +1588,7 @@ fFlags = [
   ( "dicts-cheap",                      Opt_DictsCheap, const Supported ),
   ( "inline-if-enough-args",            Opt_InlineIfEnoughArgs, const Supported ),
   ( "excess-precision",                 Opt_ExcessPrecision, const Supported ),
+  ( "eager-blackholing",                Opt_EagerBlackHoling, const Supported ),
   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
   ( "print-bind-result",                Opt_PrintBindResult, const Supported ),
   ( "force-recomp",                     Opt_ForceRecomp, const Supported ),

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 4d03a28..ee39dcd 100644 (file)
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -768,6 +768,10 @@ cmmExprConFold referenceKind expr
            -- On powerpc (non-PIC), it's easier to jump directly to a label than
            -- to use the register table, so we replace these registers
            -- with the corresponding labels:
+        CmmReg (CmmGlobal EagerBlackholeInfo)
+          | not opt_PIC
+          -> cmmExprConFold referenceKind $
+             CmmLit (CmmLabel (mkRtsCodeLabel (sLit "__stg_EAGER_BLACKHOLE_INFO"))) 
         CmmReg (CmmGlobal GCEnter1)
           | not opt_PIC
           -> cmmExprConFold referenceKind $

diff --git a/includes/ClosureTypes.h b/includes/ClosureTypes.h
index 4876931..99bd306 100644 (file)
--- a/includes/ClosureTypes.h
+++ b/includes/ClosureTypes.h
@@ -64,35 +64,33 @@
 #define STOP_FRAME             40
 #define CAF_BLACKHOLE          41
 #define BLACKHOLE              42
-#define SE_BLACKHOLE           43
-#define SE_CAF_BLACKHOLE       44
-#define MVAR_CLEAN             45
-#define MVAR_DIRTY             46
-#define ARR_WORDS              47
-#define MUT_ARR_PTRS_CLEAN      48
-#define MUT_ARR_PTRS_DIRTY      49
-#define MUT_ARR_PTRS_FROZEN0    50
-#define MUT_ARR_PTRS_FROZEN     51
-#define MUT_VAR_CLEAN          52
-#define MUT_VAR_DIRTY          53
-#define WEAK                   54
-#define STABLE_NAME            55
-#define TSO                    56
-#define BLOCKED_FETCH          57
-#define FETCH_ME                58
-#define FETCH_ME_BQ             59
-#define RBH                     60
-#define REMOTE_REF              62
-#define TVAR_WATCH_QUEUE        63
-#define INVARIANT_CHECK_QUEUE   64
-#define ATOMIC_INVARIANT        65
-#define TVAR                    66
-#define TREC_CHUNK              67
-#define TREC_HEADER             68
-#define ATOMICALLY_FRAME        69
-#define CATCH_RETRY_FRAME       70
-#define CATCH_STM_FRAME         71
-#define WHITEHOLE               72
-#define N_CLOSURE_TYPES         73
+#define MVAR_CLEAN             43
+#define MVAR_DIRTY             44
+#define ARR_WORDS              45
+#define MUT_ARR_PTRS_CLEAN      46
+#define MUT_ARR_PTRS_DIRTY      47
+#define MUT_ARR_PTRS_FROZEN0    48
+#define MUT_ARR_PTRS_FROZEN     49
+#define MUT_VAR_CLEAN          50
+#define MUT_VAR_DIRTY          51
+#define WEAK                   52
+#define STABLE_NAME            53
+#define TSO                    54
+#define BLOCKED_FETCH          55
+#define FETCH_ME                56
+#define FETCH_ME_BQ             57
+#define RBH                     58
+#define REMOTE_REF              59
+#define TVAR_WATCH_QUEUE        60
+#define INVARIANT_CHECK_QUEUE   61
+#define ATOMIC_INVARIANT        62
+#define TVAR                    63
+#define TREC_CHUNK              64
+#define TREC_HEADER             65
+#define ATOMICALLY_FRAME        66
+#define CATCH_RETRY_FRAME       67
+#define CATCH_STM_FRAME         68
+#define WHITEHOLE               69
+#define N_CLOSURE_TYPES         70
 
 #endif /* CLOSURETYPES_H */

diff --git a/includes/Regs.h b/includes/Regs.h
index cf083c9..49366ed 100644 (file)
--- a/includes/Regs.h
+++ b/includes/Regs.h
@@ -23,6 +23,7 @@
 #define REGS_H
 
 typedef struct {
+  StgWord        stgEagerBlackholeInfo;
   StgFunPtr      stgGCEnter1;
   StgFunPtr      stgGCFun;
 } StgFunTable;
@@ -399,8 +400,9 @@ GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc)
 
 #define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable)))
 
-#define stg_gc_enter_1     (FunReg->stgGCEnter1)
-#define stg_gc_fun         (FunReg->stgGCFun)
+#define stg_EAGER_BLACKHOLE_info  (FunReg->stgEagerBlackholeInfo)
+#define stg_gc_enter_1            (FunReg->stgGCEnter1)
+#define stg_gc_fun                (FunReg->stgGCFun)
 
 /* -----------------------------------------------------------------------------
    For any registers which are denoted "caller-saves" by the C calling

diff --git a/includes/RtsConfig.h b/includes/RtsConfig.h
index caf76b3..2f683cb 100644 (file)
--- a/includes/RtsConfig.h
+++ b/includes/RtsConfig.h
@@ -28,24 +28,6 @@
 #define USING_LIBBFD 1
 #endif
 
-/* Turn lazy blackholing and eager blackholing on/off.
- *
- * Using eager blackholing makes things easier to debug because
- * the blackholes are more predictable - but it's slower and less sexy.
- *
- * For now, do lazy and not eager.
- */
-
-/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
- * single-entry thunks.
- */
-/* #if defined(TICKY_TICKY) || defined(THREADED_RTS) */
-#if defined(TICKY_TICKY)
-#  define EAGER_BLACKHOLING
-#else
-#  define LAZY_BLACKHOLING
-#endif
-
 /* -----------------------------------------------------------------------------
    Labels - entry labels & info labels point to the same place in
    TABLES_NEXT_TO_CODE, so we only generate the _info label.  Jumps

diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 9158682..8911cf3 100644 (file)
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -89,11 +89,8 @@ RTS_INFO(stg_CAF_UNENTERED_info);
 RTS_INFO(stg_CAF_ENTERED_info);
 RTS_INFO(stg_WHITEHOLE_info);
 RTS_INFO(stg_BLACKHOLE_info);
+RTS_INFO(__stg_EAGER_BLACKHOLE_info);
 RTS_INFO(stg_CAF_BLACKHOLE_info);
-#ifdef TICKY_TICKY
-RTS_INFO(stg_SE_BLACKHOLE_info);
-RTS_INFO(stg_SE_CAF_BLACKHOLE_info);
-#endif
 
 #if defined(PAR) || defined(GRAN)
 RTS_INFO(stg_RBH_info);
@@ -148,11 +145,8 @@ RTS_ENTRY(stg_CAF_UNENTERED_entry);
 RTS_ENTRY(stg_CAF_ENTERED_entry);
 RTS_ENTRY(stg_WHITEHOLE_entry);
 RTS_ENTRY(stg_BLACKHOLE_entry);
+RTS_ENTRY(__stg_EAGER_BLACKHOLE_entry);
 RTS_ENTRY(stg_CAF_BLACKHOLE_entry);
-#ifdef TICKY_TICKY
-RTS_ENTRY(stg_SE_BLACKHOLE_entry);
-RTS_ENTRY(stg_SE_CAF_BLACKHOLE_entry);
-#endif
 #if defined(PAR) || defined(GRAN)
 RTS_ENTRY(stg_RBH_entry);
 #endif

diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index 3aa7625..798c6e6 100644 (file)
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -226,6 +226,7 @@ main(int argc, char *argv[])
     field_offset(StgRegTable, rmp_result1);
     field_offset(StgRegTable, rmp_result2);
 
+    def_offset("stgEagerBlackholeInfo", FUN_OFFSET(stgEagerBlackholeInfo));
     def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1));
     def_offset("stgGCFun", FUN_OFFSET(stgGCFun));
 

diff --git a/rts/Capability.c b/rts/Capability.c
index 0b3c844..27a2d51 100644 (file)
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -205,6 +205,7 @@ initCapability( Capability *cap, nat i )
     cap->sparks_pruned      = 0;
 #endif
 
+    cap->f.stgEagerBlackholeInfo = (W_)&__stg_EAGER_BLACKHOLE_info;
     cap->f.stgGCEnter1     = (F_)__stg_gc_enter_1;
     cap->f.stgGCFun        = (F_)__stg_gc_fun;
 

diff --git a/rts/ClosureFlags.c b/rts/ClosureFlags.c
index eea609e..05baad7 100644 (file)
--- a/rts/ClosureFlags.c
+++ b/rts/ClosureFlags.c
@@ -69,8 +69,6 @@ StgWord16 closure_flags[] = {
 /* STOP_FRAME          = */ (     _BTM                                  ),
 /* CAF_BLACKHOLE       = */ (     _BTM|_NS|              _UPT           ),
 /* BLACKHOLE           = */ (          _NS|              _UPT           ),
-/* SE_BLACKHOLE                = */ (          _NS|              _UPT           ),
-/* SE_CAF_BLACKHOLE    = */ (          _NS|              _UPT           ),
 /* MVAR_CLEAN          = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* MVAR_DIRTY          = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* ARR_WORDS           = */ (_HNF|     _NS|              _UPT           ),
@@ -87,7 +85,6 @@ StgWord16 closure_flags[] = {
 /* FETCH_ME            = */ (_HNF|     _NS|         _MUT|_UPT           ),
 /* FETCH_ME_BQ          = */ (                 _NS|         _MUT|_UPT           ),
 /* RBH                  = */ (                 _NS|         _MUT|_UPT           ),
-/* EVACUATED           = */ ( 0                                         ),
 /* REMOTE_REF          = */ (_HNF|     _NS|              _UPT           ),
 /* TVAR_WATCH_QUEUE     = */ (          _NS|         _MUT|_UPT           ),
 /* INVARIANT_CHECK_QUEUE= */ (          _NS|         _MUT|_UPT           ),
@@ -101,6 +98,6 @@ StgWord16 closure_flags[] = {
 /* WHITEHOLE           = */ ( 0                                         )
 };
 
-#if N_CLOSURE_TYPES != 73
+#if N_CLOSURE_TYPES != 70
 #error Closure types changed: update ClosureFlags.c!
 #endif

diff --git a/rts/FrontPanel.c b/rts/FrontPanel.c
index 5dfe87a..2ce91e2 100644 (file)
--- a/rts/FrontPanel.c
+++ b/rts/FrontPanel.c
@@ -664,8 +664,7 @@ residencyCensus( void )
                        break;
 
                    case CAF_BLACKHOLE:
-                   case SE_CAF_BLACKHOLE:
-                   case SE_BLACKHOLE:
+                   case EAGER_BLACKHOLE:
                    case BLACKHOLE:
 /*                 case BLACKHOLE_BQ: FIXME: case does not exist */
                        size = sizeW_fromITBL(info);

diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c
index 0cd80de..6a807cf 100644 (file)
--- a/rts/LdvProfile.c
+++ b/rts/LdvProfile.c
@@ -143,9 +143,7 @@ processHeapClosureForDead( StgClosure *c )
     case FUN_1_1:
     case FUN_0_2:
     case BLACKHOLE:
-    case SE_BLACKHOLE:
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
     case IND_PERM:
     case IND_OLDGEN_PERM:
        /*

diff --git a/rts/Linker.c b/rts/Linker.c
index 1fbe602..67a510b 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -763,6 +763,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stable_ptr_table)                  \
       SymI_HasProto(stackOverflow)                     \
       SymI_HasProto(stg_CAF_BLACKHOLE_info)            \
+      SymI_HasProto(__stg_EAGER_BLACKHOLE_info)                \
       SymI_HasProto(awakenBlockedQueue)                        \
       SymI_HasProto(startTimer)                         \
       SymI_HasProto(stg_CHARLIKE_closure)              \

diff --git a/rts/Printer.c b/rts/Printer.c
index 3e80bd1..1ad6306 100644 (file)
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -306,14 +306,6 @@ printClosure( StgClosure *obj )
             debugBelch("BH\n"); 
             break;
 
-    case SE_BLACKHOLE:
-            debugBelch("SE_BH\n"); 
-            break;
-
-    case SE_CAF_BLACKHOLE:
-            debugBelch("SE_CAF_BH\n"); 
-            break;
-
     case ARR_WORDS:
         {
             StgWord i;

diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 9cb47a1..36d4eb5 100644 (file)
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -144,8 +144,6 @@ static char *type_names[] = {
     "STOP_FRAME",
     "CAF_BLACKHOLE",
     "BLACKHOLE",
-    "SE_BLACKHOLE",
-    "SE_CAF_BLACKHOLE",
     "MVAR_CLEAN",
     "MVAR_DIRTY",
     "ARR_WORDS",
@@ -162,7 +160,6 @@ static char *type_names[] = {
     "FETCH_ME",
     "FETCH_ME_BQ",
     "RBH",
-    "EVACUATED",
     "REMOTE_REF",
     "TVAR_WATCH_QUEUE",
     "INVARIANT_CHECK_QUEUE",
@@ -173,6 +170,7 @@ static char *type_names[] = {
     "ATOMICALLY_FRAME",
     "CATCH_RETRY_FRAME",
     "CATCH_STM_FRAME",
+    "WHITEHOLE",
     "N_CLOSURE_TYPES"
   };
 #endif
@@ -960,8 +958,6 @@ heapCensusChain( Census *census, bdescr *bd )
            case IND_OLDGEN:
            case IND_OLDGEN_PERM:
            case CAF_BLACKHOLE:
-           case SE_CAF_BLACKHOLE:
-           case SE_BLACKHOLE:
            case BLACKHOLE:
            case FUN_1_0:
            case FUN_0_1:

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 8d6126a..2bd213a 100644 (file)
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -453,8 +453,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case CONSTR_0_2:
     case CAF_BLACKHOLE:
     case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
     case ARR_WORDS:
        *first_child = NULL;
        return;
@@ -958,8 +956,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
        case CONSTR_0_2:
        case CAF_BLACKHOLE:
        case BLACKHOLE:
-       case SE_BLACKHOLE:
-       case SE_CAF_BLACKHOLE:
        case ARR_WORDS:
            // one child (fixed), no SRT
        case MUT_VAR_CLEAN:
@@ -1112,8 +1108,6 @@ isRetainer( StgClosure *c )
        // blackholes
     case CAF_BLACKHOLE:
     case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
        // indirection
     case IND_PERM:
     case IND_OLDGEN_PERM:

diff --git a/rts/Sanity.c b/rts/Sanity.c
index 8f3b627..71eae44 100644 (file)
--- a/rts/Sanity.c
+++ b/rts/Sanity.c
@@ -312,10 +312,6 @@ checkClosure( StgClosure* p )
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-#ifdef TICKY_TICKY
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-#endif
     case BLACKHOLE:
     case CAF_BLACKHOLE:
     case STABLE_NAME:

diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index d22a880..7f7cf78 100644 (file)
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -384,14 +384,33 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
     jump stg_block_blackhole;
 }
 
-#ifdef EAGER_BLACKHOLING
-INFO_TABLE(stg_SE_BLACKHOLE,0,1,SE_BLACKHOLE,"SE_BLACKHOLE","SE_BLACKHOLE")
-{ foreign "C" barf("SE_BLACKHOLE object entered!") never returns; }
+INFO_TABLE(__stg_EAGER_BLACKHOLE,0,1,BLACKHOLE,"EAGER_BLACKHOLE","EAGER_BLACKHOLE")
+{
+    TICK_ENT_BH();
+
+#ifdef THREADED_RTS
+    // foreign "C" debugBelch("BLACKHOLE entry\n");
+#endif
 
-INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_BLACKHOLE")
-{ foreign "C" barf("SE_CAF_BLACKHOLE object entered!") never returns; }
+    /* Actually this is not necessary because R1 is about to be destroyed. */
+    LDV_ENTER(R1);
+
+#if defined(THREADED_RTS)
+    ACQUIRE_LOCK(sched_mutex "ptr");
+    // released in stg_block_blackhole_finally
 #endif
 
+    /* Put ourselves on the blackhole queue */
+    StgTSO__link(CurrentTSO) = W_[blackhole_queue];
+    W_[blackhole_queue] = CurrentTSO;
+
+    /* jot down why and on what closure we are blocked */
+    StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
+    StgTSO_block_info(CurrentTSO) = R1;
+
+    jump stg_block_blackhole;
+}
+
 /* ----------------------------------------------------------------------------
    Whiteholes are used for the "locked" state of a closure (see lockClosure())
    ------------------------------------------------------------------------- */

diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c
index 5463dee..674d0d9 100644 (file)
--- a/rts/ThreadPaused.c
+++ b/rts/ThreadPaused.c
@@ -250,9 +250,6 @@ threadPaused(Capability *cap, StgTSO *tso)
            }
 
            if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
-#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-               debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh);
-#endif
                // zero out the slop so that the sanity checker can tell
                // where the next closure is.
                DEBUG_FILL_SLOP(bh);
@@ -261,7 +258,7 @@ threadPaused(Capability *cap, StgTSO *tso)
                // We pretend that bh is now dead.
                LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
 #endif
-
+                // an EAGER_BLACKHOLE gets turned into a BLACKHOLE here.
 #ifdef THREADED_RTS
                 cur_bh_info = (const StgInfoTable *)
                     cas((StgVolatilePtr)&bh->header.info, 

diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index b43c0ea..fcd7cb1 100644 (file)
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -621,8 +621,6 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
     {
        StgPtr end;

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 736c6c8..bbb7fe5 100644 (file)
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -626,8 +626,6 @@ loop:
       return;
 
   case CAF_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case SE_BLACKHOLE:
   case BLACKHOLE:
       copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
       return;
@@ -1038,8 +1036,6 @@ selector_loop:
       case THUNK_0_2:
       case THUNK_STATIC:
       case CAF_BLACKHOLE:
-      case SE_CAF_BLACKHOLE:
-      case SE_BLACKHOLE:
       case BLACKHOLE:
          // not evaluated yet 
          goto bale_out;

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index b8fb54b..24f19c9 100644 (file)
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -504,8 +504,6 @@ scavenge_block (bdescr *bd)
        break;
 
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
        p += BLACKHOLE_sizeW();
        break;
@@ -881,8 +879,6 @@ linear_scan:
        }
 
        case CAF_BLACKHOLE:
-       case SE_CAF_BLACKHOLE:
-       case SE_BLACKHOLE:
        case BLACKHOLE:
        case ARR_WORDS:
            break;
@@ -1197,8 +1193,6 @@ scavenge_one(StgPtr p)
     }
 
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
        break;
        

diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs
index 017927f..9d0febb 100644 (file)
--- a/utils/genapply/GenApply.hs
+++ b/utils/genapply/GenApply.hs
@@ -566,8 +566,6 @@ genApply regstatus args =
        text "     AP_STACK,",
        text "     CAF_BLACKHOLE,",
        text "     BLACKHOLE,",
-       text "     SE_BLACKHOLE,",
-       text "     SE_CAF_BLACKHOLE,",
         text "     THUNK,",
         text "     THUNK_1_0,",
         text "     THUNK_0_1,",