refactoring and fixing the stage 2 compilation

13 files changed, 200 insertions, 262 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 14aa1837c7..e1893836ab 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -22,7 +22,7 @@ module CLabel (
 	mkSRTLabel,
 	mkInfoTableLabel,
 	mkEntryLabel,
-	mkSlowEntryLabel, slowEntryFromInfoLabel,
+        mkSlowEntryLabel,
 	mkConEntryLabel,
 	mkStaticConEntryLabel,
 	mkRednCountsLabel,
@@ -100,11 +100,12 @@ module CLabel (
         mkHpcTicksLabel,
 
         hasCAF,
-	cvtToClosureLbl,
-	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
  	isCFunctionLabel, isGcPtrLabel, labelDynamic,
-        infoLblToEntryLbl, entryLblToInfoLbl,
+
+        -- * Conversions
+        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
 
         pprCLabel
     ) where
@@ -359,7 +360,6 @@ data DynamicLinkerLabelInfo
 -- Constructing IdLabels 
 -- These are always local:
 mkSlowEntryLabel      	name c 	       = IdLabel name  c Slow
-slowEntryFromInfoLabel (IdLabel n c _) = IdLabel n c Slow
 
 mkSRTLabel		name c	= IdLabel name  c SRT
 mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
@@ -506,39 +506,40 @@ mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod	= PlainModuleInitLabel mod
 
 -- -----------------------------------------------------------------------------
--- Brutal method of obtaining a closure label
-
-cvtToClosureLbl   (IdLabel n c InfoTable)       = IdLabel n c Closure
-cvtToClosureLbl   (IdLabel n c LocalInfoTable)  = IdLabel n c Closure -- XXX?
-cvtToClosureLbl   (IdLabel n c Entry)           = IdLabel n c Closure
-cvtToClosureLbl   (IdLabel n c LocalEntry)      = IdLabel n c Closure -- XXX?
-cvtToClosureLbl   (IdLabel n c ConEntry)        = IdLabel n c Closure
-cvtToClosureLbl   (IdLabel n c RednCounts)	= IdLabel n c Closure
-cvtToClosureLbl l@(IdLabel n c Closure)		= l
-cvtToClosureLbl l 
-	= pprPanic "cvtToClosureLbl" (pprCLabel l)
-
-infoLblToEntryLbl :: CLabel -> CLabel 
-infoLblToEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
-infoLblToEntryLbl (IdLabel n c InfoTable)      = IdLabel n c Entry
-infoLblToEntryLbl (IdLabel n c ConInfoTable)   = IdLabel n c ConEntry
-infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
-infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
-infoLblToEntryLbl (CmmLabel m str CmmInfo)     = CmmLabel m str CmmEntry
-infoLblToEntryLbl (CmmLabel m str CmmRetInfo)  = CmmLabel m str CmmRet
-infoLblToEntryLbl _
-       = panic "CLabel.infoLblToEntryLbl"
-
-entryLblToInfoLbl :: CLabel -> CLabel 
-entryLblToInfoLbl (IdLabel n c Entry)          = IdLabel n c InfoTable
-entryLblToInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
-entryLblToInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
-entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
-entryLblToInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
-entryLblToInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
-entryLblToInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
-entryLblToInfoLbl l                            
-       = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
+-- Convert between different kinds of label
+
+toClosureLbl :: CLabel -> CLabel
+toClosureLbl (IdLabel n c _) = IdLabel n c Closure
+toClosureLbl l = pprPanic "toClosureLbl" (pprCLabel l)
+
+toSlowEntryLbl :: CLabel -> CLabel
+toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
+toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (pprCLabel l)
+
+toRednCountsLbl :: CLabel -> CLabel
+toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
+toRednCountsLbl l = pprPanic "toRednCountsLbl" (pprCLabel l)
+
+toEntryLbl :: CLabel -> CLabel
+toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
+toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
+toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
+toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
+toEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
+toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
+toEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
+toEntryLbl l = pprPanic "toEntryLbl" (pprCLabel l)
+
+toInfoLbl :: CLabel -> CLabel
+toInfoLbl (IdLabel n c Entry)          = IdLabel n c InfoTable
+toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
+toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
+toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
+toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
+toInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
+toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
+toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
+toInfoLbl l = pprPanic "CLabel.toInfoLbl" (pprCLabel l)
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel refer to a CAF?
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 3e54aacc77..699f1003b6 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -203,7 +203,7 @@ cafTransfers = mkBTransfer3 first middle last
                CmmLit (CmmLabelOff c _)         -> add c set
                CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $ add c2 set
                _ -> set
-        add l s = if hasCAF l then Map.insert (cvtToClosureLbl l) () s else s
+        add l s = if hasCAF l then Map.insert (toClosureLbl l) () s else s
 
 cafAnal :: CmmGraph -> FuelUniqSM CAFEnv
 cafAnal g = liftM snd $ dataflowPassBwd g [] $ analBwd cafLattice cafTransfers
@@ -341,7 +341,7 @@ localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
   case info_tbl top_info of
     CmmInfoTable { cit_rep = rep } 
       | not (isStaticRep rep) 
-      -> Just (cvtToClosureLbl top_l,
+      -> Just (toClosureLbl top_l,
                expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
     _ -> Nothing
 
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index c270e01706..a11b61cb91 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -156,7 +156,7 @@ mkInfoTableContents info@(CmmInfoTable { cit_lbl  = info_lbl
                               , srt_lit, liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
-        slow_entry = CmmLabel (slowEntryFromInfoLabel info_lbl)
+        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
         srt_lit = case srt_label of
                     []          -> mkIntCLit 0
                     (lit:_rest) -> ASSERT( null _rest ) lit
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index d158bf78ab..ffaa5eec8b 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -449,38 +449,14 @@ blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 
 emitBlackHoleCode :: Bool -> Code
 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
-	-- 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]
-	--
-	-- Profiling needs slop filling (to support LDV profiling), so
-	-- currently eager blackholing doesn't work with profiling.
-	--
-        -- 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
-
-  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)
-	  stmtsC [
-              CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
-                       (CmmReg (CmmGlobal CurrentTSO)),
-              CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
-	      CmmStore (CmmReg nodeReg) bh_info
-            ]
-     else
-          nopC
+    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
+     ]
 \end{code}
 
 \begin{code}
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index c55a9f936f..de4318afb0 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -33,7 +33,7 @@ module ClosureInfo (
 	isLFThunk, closureUpdReqd,
 	closureNeedsUpdSpace, closureIsThunk,
 	closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
-	closureFunInfo,	isStandardFormThunk, isKnownFun,
+        closureFunInfo, isKnownFun,
         funTag, funTagLFInfo, tagForArity, clHasCafRefs,
 
 	enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
@@ -118,7 +118,7 @@ data ClosureInfo
 	closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
 	closureSMRep  :: !SMRep,	  -- representation used by storage mgr
 	closureSRT    :: !C_SRT,	  -- What SRT applies to this closure
-	closureType   :: !Type,		  -- Type of closure (ToDo: remove)
+        closureType   :: !Type,           -- Type of closure (ToDo: remove)
 	closureDescr  :: !String,	  -- closure description (for profiling)
 	closureInfLcl :: Bool             -- can the info pointer be a local symbol?
     }
@@ -707,35 +707,48 @@ getCallMethod _ name _ (LFLetNoEscape arity) n_args
   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 
-blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
+
+-- 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.
--- Updatable ones will be overwritten with a CAFList cell, which points to a 
--- black hole;
--- Single-entry ones have no fvs to plug, and we trust they don't form part 
--- of a loop.
 
+blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
 blackHoleOnEntry _ ConInfo{} = False
-blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
-  | isStaticRep rep
+blackHoleOnEntry dflags cl_info
+  | isStaticRep (closureSMRep cl_info)
   = False	-- Never black-hole a static closure
 
   | otherwise
-  = case lf_info of
+  = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
-	LFLetNoEscape _		  -> False
+        LFLetNoEscape _           -> False
 	LFThunk _ no_fvs updatable _ _
-	  -> if updatable
-	     then not opt_OmitBlackHoling
-	     else doingTickyProfiling dflags || not no_fvs
+          | 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
 
-	_ -> panic "blackHoleOnEntry"	-- Should never happen
+           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.
 
-isStandardFormThunk :: LambdaFormInfo -> Bool
-isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
-isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)	= True
-isStandardFormThunk _ 			= False
+        _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isKnownFun :: LambdaFormInfo -> Bool
 isKnownFun (LFReEntrant _ _ _ _) = True
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 9afdf02a90..ade0be1a94 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -502,34 +502,14 @@ blackHoleIt :: ClosureInfo -> FCode ()
 blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 
 emitBlackHoleCode :: Bool -> FCode ()
-emitBlackHoleCode is_single_entry
-  | eager_blackholing = 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)))
-  | otherwise =
-	nopC
+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")
-
-	-- 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]
-	--
-	-- Profiling needs slop filling (to support LDV profiling), so
-	-- currently eager blackholing doesn't work with profiling.
-	--
-        -- 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
-
-    eager_blackholing = False
-
 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 9447edfad9..300606eb7e 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -7,8 +7,6 @@
 --
 -- Nothing monadic in here!
 --
--- (c) The University of Glasgow 2004-2006
---
 -----------------------------------------------------------------------------
 
 {-# LANGUAGE RecordWildCards #-}
@@ -19,8 +17,8 @@ module StgCmmClosure (
         isVoidRep, isGcPtrRep, addIdReps, addArgReps,
 	argPrimRep, 
 
-	-----------------------------------
-	LambdaFormInfo,		-- Abstract
+        -- * LambdaFormInfo
+        LambdaFormInfo,         -- Abstract
 	StandardFormInfo,	-- ...ditto...
 	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
 	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
@@ -28,33 +26,37 @@ module StgCmmClosure (
         lfDynTag,
         maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable,
 
-	-----------------------------------
+        nodeMustPointToIt,
+        CallMethod(..), getCallMethod,
+
+        isKnownFun, funTag, tagForArity,
+
+        -- * ClosureInfo
 	ClosureInfo,
         mkClosureInfo,
         mkCmmInfo,
 
-        closureSize, closureName,
+        -- ** Inspection
+        closureLFInfo, closureName,
 
-        closureEntryLabel, closureInfoTableLabel, staticClosureLabel,
+        -- ** Labels
+        -- These just need the info table label
+        closureInfoLabel, staticClosureLabel,
         closureRednCountsLabel, closureSlowEntryLabel, closureLocalEntryLabel,
 
-        closureLFInfo,
+        -- ** Predicates
+        -- These are really just functions on LambdaFormInfo
         closureUpdReqd, closureSingleEntry,
-	closureReEntrant, closureFunInfo, isStandardFormThunk,
-	isKnownFun, funTag, tagForArity,
-
-        nodeMustPointToIt,
-	CallMethod(..), getCallMethod,
-
-	blackHoleOnEntry,
+        closureReEntrant, closureFunInfo,
+        isToplevClosure,
 
-	isToplevClosure,
-	isStaticClosure,
-
-        staticClosureNeedsLink,
+        blackHoleOnEntry,  -- Needs LambdaFormInfo and SMRep
+        isStaticClosure,   -- Needs SMPre
 
+        -- * InfoTables
         mkDataConInfoTable,
-        cafBlackHoleInfoTable
+        cafBlackHoleInfoTable,
+        staticClosureNeedsLink,
     ) where
 
 #include "../includes/MachDeps.h"
@@ -85,6 +87,8 @@ import DynFlags
 --		Representations
 -----------------------------------------------------------------------------
 
+-- Why are these here?
+
 addIdReps :: [Id] -> [(PrimRep, Id)]
 addIdReps ids = [(idPrimRep id, id) | id <- ids]
 
@@ -154,36 +158,6 @@ data LambdaFormInfo
 
 
 -------------------------
--- An ArgDsecr describes the argument pattern of a function
-
-{-	XXX  -- imported from old ClosureInfo for now
-data ArgDescr
-  = ArgSpec		-- Fits one of the standard patterns
-	!StgHalfWord	-- RTS type identifier ARG_P, ARG_N, ...
-
-  | ArgGen	 	-- General case
-	Liveness	-- Details about the arguments
--}
-
-{-	XXX  -- imported from old ClosureInfo for now
--------------------------
--- We represent liveness bitmaps as a Bitmap (whose internal
--- representation really is a bitmap).  These are pinned onto case return
--- vectors to indicate the state of the stack for the garbage collector.
--- 
--- In the compiled program, liveness bitmaps that fit inside a single
--- word (StgWord) are stored as a single word, while larger bitmaps are
--- stored as a pointer to an array of words. 
-
-data Liveness
-  = SmallLiveness	-- Liveness info that fits in one word
-	StgWord		-- Here's the bitmap
-
-  | BigLiveness		-- Liveness info witha a multi-word bitmap
-	CLabel		-- Label for the bitmap
--}
-
--------------------------
 -- StandardFormInfo tells whether this thunk has one of 
 -- a small number of standard forms
 
@@ -543,11 +517,6 @@ getCallMethod _ _name _ LFBlackHole _n_args
 getCallMethod _ _name _ LFLetNoEscape _n_args
   = JumpToIt
 
-isStandardFormThunk :: LambdaFormInfo -> Bool
-isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
-isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)	= True
-isStandardFormThunk _other_lf_info 			= False
-
 isKnownFun :: LambdaFormInfo -> Bool
 isKnownFun (LFReEntrant _ _ _ _) = True
 isKnownFun LFLetNoEscape	 = True
@@ -640,53 +609,50 @@ staticClosureRequired binder other_binder_info other_lf_info = True
 -}
 
 -----------------------------------------------------------------------------
---		Data types for closure information}
+--              Data types for closure information
 -----------------------------------------------------------------------------
 
 
-{- Information about a closure, from the code generator's point of view.
+{- ClosureInfo: information about a binding
 
-A ClosureInfo decribes the info pointer of a closure.  It has
-enough information 
-  a) to construct the info table itself
-  b) to allocate a closure containing that info pointer (i.e.
-	it knows the info table label)
+   We make a ClosureInfo for each let binding (both top level and not),
+   but not bindings for data constructors: for those we build a CmmInfoTable
+   directly (see mkDataConInfoTable).
 
-We make a ClosureInfo for each let binding (both top level and not),
-but not bindings for data constructors.
-
-Note [Closure CAF info]
-~~~~~~~~~~~~~~~~~~~~~~~
-The closureCafs field is relevant for *static closures only*.  It
-records whether a CAF is reachable from the code for the closure It is
-initialised simply from the idCafInfo of the Id.
+   To a first approximation:
+       ClosureInfo = (LambdaFormInfo, CmmInfoTable)
 
+   A ClosureInfo has enough information
+     a) to construct the info table itself, and build other things
+        related to the binding (e.g. slow entry points for a function)
+     b) to allocate a closure containing that info pointer (i.e.
+   	it knows the info table label)
 -}
 
 data ClosureInfo
   = ClosureInfo {
-          -- these three are for making labels related to this closure:
-        closureName    :: !Name,           -- The thing bound to this closure
-        closureCafs    :: !CafInfo,        -- used for making labels only
-        closureLocal   :: !Bool,           -- make local labels?
-
-          -- this tells us about what the closure contains:
-        closureLFInfo  :: !LambdaFormInfo, -- NOTE: not an LFCon
-
-          -- these fields tell us about the representation of the closure,
-          -- and are used for making an info table:
-        closureSMRep   :: !SMRep,          -- representation used by storage mgr
-        closureSRT     :: !C_SRT,          -- What SRT applies to this closure
-        closureProf    :: !ProfilingInfo
+        closureName :: !Name,           -- The thing bound to this closure
+           -- we don't really need this field: it's only used in generating
+           -- code for ticky and profiling, and we could pass the information
+           -- around separately, but it doesn't do much harm to keep it here.
+
+        closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
+          -- this tells us about what the closure contains: it's right-hand-side.
+
+          -- the rest is just an unpacked CmmInfoTable.
+        closureInfoLabel :: !CLabel,
+        closureSMRep     :: !SMRep,          -- representation used by storage mgr
+        closureSRT       :: !C_SRT,          -- What SRT applies to this closure
+        closureProf      :: !ProfilingInfo
     }
 
 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
 mkCmmInfo :: ClosureInfo -> CmmInfoTable
-mkCmmInfo cl_info
-  = CmmInfoTable { cit_lbl  = closureInfoTableLabel cl_info,
-                   cit_rep  = closureSMRep cl_info,
-                   cit_prof = closureProf cl_info,
-                   cit_srt  = closureSRT cl_info }
+mkCmmInfo ClosureInfo {..}
+  = CmmInfoTable { cit_lbl  = closureInfoLabel
+                 , cit_rep  = closureSMRep
+                 , cit_prof = closureProf
+                 , cit_srt  = closureSRT }
 
 
 --------------------------------------
@@ -701,60 +667,64 @@ mkClosureInfo :: Bool		-- Is static
 	      -> String		-- String descriptor
 	      -> ClosureInfo
 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
-  = ClosureInfo { closureName    = name,
-                  closureCafs    = cafs,
-                  closureLocal   = is_local,
-                  closureLFInfo  = lf_info,
-                  closureSMRep   = sm_rep,    -- These four fields are a
-                  closureSRT     = srt_info,  --        CmmInfoTable
-                  closureProf    = prof }     -- ---
+  = ClosureInfo { closureName      = name,
+                  closureLFInfo    = lf_info,
+                  closureInfoLabel = info_lbl,
+                  closureSMRep     = sm_rep,    -- These four fields are a
+                  closureSRT       = srt_info,  --        CmmInfoTable
+                  closureProf      = prof }     -- ---
   where
     name       = idName id
     sm_rep     = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
     prof       = mkProfilingInfo id val_descr
     nonptr_wds = tot_wds - ptr_wds
 
-    cafs     = idCafInfo id
-    is_local = isDataConWorkId id
-       -- Make the _info pointer for the implicit datacon worker
-       -- binding local. The reason we can do this is that importing
-       -- code always either uses the _closure or _con_info. By the
-       -- invariants in CorePrep anything else gets eta expanded.
+    info_lbl = mkClosureInfoTableLabel id lf_info
 
 --------------------------------------
---   Functions about closure *sizes*
+--   Other functions over ClosureInfo
 --------------------------------------
 
-closureSize :: ClosureInfo -> WordOff
-closureSize cl_info = heapClosureSize (closureSMRep cl_info)
+-- 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.
 
---------------------------------------
---   Other functions over ClosureInfo
---------------------------------------
+-- 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
 
-blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
 -- Static closures are never themselves black-holed.
--- Updatable ones will be overwritten with a CAFList cell, which points to a 
--- black hole;
--- Single-entry ones have no fvs to plug, and we trust they don't form part 
--- of a loop.
 
-blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
-  | isStaticRep rep
+blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
+blackHoleOnEntry dflags cl_info
+  | isStaticRep (closureSMRep cl_info)
   = False	-- Never black-hole a static closure
 
   | otherwise
-  = case lf_info of
+  = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
 	LFLetNoEscape 		  -> False
-	LFThunk _ no_fvs updatable _ _
-	  -> if updatable
-	     then not opt_OmitBlackHoling
-	     else doingTickyProfiling dflags || not no_fvs
+        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
 
-	_other -> panic "blackHoleOnEntry"	-- Should never happen
+           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.
+
+        _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isStaticClosure :: ClosureInfo -> Bool
 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
@@ -798,27 +768,22 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 --   Label generation
 --------------------------------------
 
-closureEntryLabel :: ClosureInfo -> CLabel
-closureEntryLabel = infoLblToEntryLbl . closureInfoTableLabel
-
 staticClosureLabel :: ClosureInfo -> CLabel
-staticClosureLabel = cvtToClosureLbl .  closureInfoTableLabel
+staticClosureLabel = toClosureLbl .  closureInfoLabel
 
 closureRednCountsLabel :: ClosureInfo -> CLabel
-closureRednCountsLabel ClosureInfo{..} = mkRednCountsLabel closureName closureCafs
+closureRednCountsLabel = toRednCountsLbl . closureInfoLabel
 
 closureSlowEntryLabel :: ClosureInfo -> CLabel
-closureSlowEntryLabel ClosureInfo{..} = mkSlowEntryLabel closureName closureCafs
+closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
 
 closureLocalEntryLabel :: ClosureInfo -> CLabel
-closureLocalEntryLabel ClosureInfo{..} = enterLocalIdLabel closureName closureCafs
-
+closureLocalEntryLabel
+  | tablesNextToCode = toInfoLbl  . closureInfoLabel
+  | otherwise        = toEntryLbl . closureInfoLabel
 
-closureInfoTableLabel :: ClosureInfo -> CLabel
-closureInfoTableLabel ClosureInfo { closureName = name
-                                  , closureCafs =  cafs
-                                  , closureLocal = is_local
-                                  , closureLFInfo =  lf_info }
+mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
+mkClosureInfoTableLabel id lf_info
   = case lf_info of
         LFBlackHole -> mkCAFBlackHoleInfoTableLabel
 
@@ -833,9 +798,18 @@ closureInfoTableLabel ClosureInfo { closureName = name
         _other        -> panic "closureInfoTableLabel"
 
   where 
+    name = idName id
+
     std_mk_lbl | is_local  = mkLocalInfoTableLabel
                | otherwise = mkInfoTableLabel
 
+    cafs     = idCafInfo id
+    is_local = isDataConWorkId id
+       -- Make the _info pointer for the implicit datacon worker
+       -- binding local. The reason we can do this is that importing
+       -- code always either uses the _closure or _con_info. By the
+       -- invariants in CorePrep anything else gets eta expanded.
+
 
 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
 -- thunkEntryLabel is a local help function, not exported.  It's used from
@@ -862,11 +836,6 @@ enterIdLabel id c
   | tablesNextToCode = mkInfoTableLabel id c
   | otherwise        = mkEntryLabel id c
 
-enterLocalIdLabel :: Name -> CafInfo -> CLabel
-enterLocalIdLabel id c
-  | tablesNextToCode = mkLocalInfoTableLabel id c
-  | otherwise        = mkLocalEntryLabel id c
-
 
 --------------------------------------
 --   Profiling
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 8b94abf828..58d858f729 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -396,7 +396,7 @@ emitClosureAndInfoTable ::
   CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
 emitClosureAndInfoTable info_tbl conv args body
   = do { blks <- getCode body
-       ; let entry_lbl = infoLblToEntryLbl (cit_lbl info_tbl)
+       ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)
        ; emitProcWithConvention conv info_tbl entry_lbl args blks
        }
 
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 2ec6555a54..2920b84822 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -30,6 +30,7 @@ import PrimOp
 import Constants
 import FastString
 import SMRep
+import ClosureInfo -- CgRep stuff
 import DynFlags
 import Outputable
 import Platform
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index e8df54c7c6..8cbf5d0310 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -39,6 +39,7 @@ import Unique
 import FastString
 import Panic
 import SMRep
+import ClosureInfo
 import Bitmap
 import OrdList
 import Constants
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index 49c5488efa..c7ff1a41e9 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -26,6 +26,7 @@ import DataCon
 import VarSet
 import PrimOp
 import SMRep
+import ClosureInfo -- CgRep stuff
 
 import Module (Module)
 import GHC.Exts
diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 943c9e9992..78b06e77a8 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -21,7 +21,7 @@ module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls
 
 import Name		( Name, getName )
 import NameEnv
-import SMRep		( typeCgRep )
+import ClosureInfo
 import DataCon		( DataCon, dataConRepArgTys, dataConIdentity )
 import TyCon		( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
 import Constants	( mIN_PAYLOAD_SIZE, wORD_SIZE )
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 307f6f104a..d225e39743 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -77,8 +77,7 @@ module StaticFlags (
 	opt_GranMacros,
 	opt_HiVersion,
 	opt_HistorySize,
-	opt_OmitBlackHoling,
-	opt_Unregisterised,
+        opt_Unregisterised,
 	v_Ld_inputs,
 	tablesNextToCode,
         opt_StubDeadValues,
@@ -321,9 +320,6 @@ opt_HiVersion			= read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
 opt_HistorySize :: Int
 opt_HistorySize			= lookup_def_int "-fhistory-size" 20
 
-opt_OmitBlackHoling :: Bool
-opt_OmitBlackHoling		= lookUp  (fsLit "-dno-black-holing")
-
 opt_StubDeadValues  :: Bool
 opt_StubDeadValues		= lookUp  (fsLit "-dstub-dead-values")