fix the eager-blackholing check, which I inadvertently broke in
authorSimon Marlow <marlowsd@gmail.com>
Tue, 6 Sep 2011 11:57:26 +0000 (12:57 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 6 Sep 2011 12:48:32 +0000 (13:48 +0100)
1c2f89535394958f75cfb15c8c5e0433a20953ed (symptom was broken
biographical profiling, see #5451).

compiler/codeGen/CgClosure.lhs
compiler/codeGen/ClosureInfo.lhs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmClosure.hs

index ffaa5ee..2f31201 100644 (file)
@@ -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}
 
index c4a6c0c..04f7acb 100644 (file)
@@ -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
index ade0be1..f34fdb8 100644 (file)
@@ -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
index 300606e..12624ba 100644 (file)
@@ -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