Fix -split-objs with the new code generator

We need to make the SRT label external and unique when splitting,
because it is shared amongst all the functions in the module.  Also
some SRT-related cleanup.

6 files changed, 33 insertions, 36 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index ed4b56767a..907f8521e1 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -13,6 +13,7 @@ module CLabel (
 
         mkClosureLabel,
         mkSRTLabel,
+        mkModSRTLabel,
         mkInfoTableLabel,
         mkEntryLabel,
         mkSlowEntryLabel,
@@ -119,6 +120,8 @@ import DynFlags
 import Platform
 import UniqSet
 
+import Data.Maybe (isJust)
+
 -- -----------------------------------------------------------------------------
 -- The CLabel type
 
@@ -214,6 +217,9 @@ data CLabel
   -- | Per-module table of tick locations
   | HpcTicksLabel Module
 
+  -- | Static reference table
+  | SRTLabel (Maybe Module) !Unique
+
   -- | Label of an StgLargeSRT
   | LargeSRTLabel
         {-# UNPACK #-} !Unique
@@ -271,7 +277,9 @@ pprDebugCLabel lbl
 
 data IdLabelInfo
   = Closure             -- ^ Label for closure
-  | SRT                 -- ^ Static reference table
+  | SRT                 -- ^ Static reference table (TODO: could be removed
+                        -- with the old code generator, but might be needed
+                        -- when we implement the New SRT Plan)
   | InfoTable           -- ^ Info tables for closures; always read-only
   | Entry               -- ^ Entry point
   | Slow                -- ^ Slow entry point
@@ -347,6 +355,9 @@ data DynamicLinkerLabelInfo
 mkSlowEntryLabel :: Name -> CafInfo -> CLabel
 mkSlowEntryLabel        name c         = IdLabel name  c Slow
 
+mkModSRTLabel     :: Maybe Module -> Unique -> CLabel
+mkModSRTLabel mb_mod u = SRTLabel mb_mod u
+
 mkSRTLabel        :: Name -> CafInfo -> CLabel
 mkRednCountsLabel :: Name -> CafInfo -> CLabel
 mkSRTLabel              name c  = IdLabel name  c SRT
@@ -581,7 +592,7 @@ needsCDecl :: CLabel -> Bool
   -- False <=> it's pre-declared; don't bother
   -- don't bother declaring SRT & Bitmap labels, we always make sure
   -- they are defined before use.
-needsCDecl (IdLabel _ _ SRT)            = False
+needsCDecl (SRTLabel _ _)               = False
 needsCDecl (LargeSRTLabel _)            = False
 needsCDecl (LargeBitmapLabel _)         = False
 needsCDecl (IdLabel _ _ _)              = True
@@ -729,6 +740,7 @@ externallyVisibleCLabel (CCS_Label _)           = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)       = True
 externallyVisibleCLabel (LargeBitmapLabel _)    = False
+externallyVisibleCLabel (SRTLabel mb_mod _)     = isJust mb_mod
 externallyVisibleCLabel (LargeSRTLabel _)       = False
 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
@@ -776,6 +788,7 @@ labelType (RtsLabel (RtsApFast _))              = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
 labelType (CaseLabel _ _)                       = CodeLabel
 labelType (PlainModuleInitLabel _)              = CodeLabel
+labelType (SRTLabel _ _)                        = CodeLabel
 labelType (LargeSRTLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
 labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
@@ -978,6 +991,11 @@ pprCLbl (CaseLabel u (CaseAlt tag))
 pprCLbl (CaseLabel u CaseDefault)
   = hcat [pprUnique u, ptext (sLit "_dflt")]
 
+pprCLbl (SRTLabel mb_mod u)
+  = pp_mod <> pprUnique u <> pp_cSEP <> ptext (sLit "srt")
+  where pp_mod | Just mod <- mb_mod = ppr mod <> pp_cSEP
+               | otherwise          = empty
+
 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 309536b963..0cfcc0d5be 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -32,10 +32,9 @@ import Bitmap
 import CLabel
 import Cmm
 import CmmUtils
-import IdInfo
 import Data.List
 import Maybes
-import Name
+import Module
 import Outputable
 import SMRep
 import UniqSupply
@@ -137,9 +136,9 @@ instance Outputable TopSRT where
                    <+> ppr elts
                    <+> ppr eltmap
 
-emptySRT :: MonadUnique m => m TopSRT
-emptySRT =
-  do top_lbl <- getUniqueM >>= \ u -> return $ mkSRTLabel (mkFCallName u "srt") NoCafRefs
+emptySRT :: MonadUnique m => Maybe Module -> m TopSRT
+emptySRT mb_mod =
+  do top_lbl <- getUniqueM >>= \ u -> return $ mkModSRTLabel mb_mod u
      return TopSRT { lbl = top_lbl, next_elt = 0, rev_elts = [], elt_map = Map.empty }
 
 cafMember :: TopSRT -> CLabel -> Bool
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index b8ed1aa939..d74533d76e 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -143,7 +143,6 @@ cgTopRhs bndr (StgRhsCon _cc con args)
 
 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
   = ASSERT(null fvs)    -- There should be no free variables
-    setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
     forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
 
 
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 9f1f161d37..e4611237cc 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -180,15 +180,13 @@ cgLookupPanic :: Id -> FCode a
 cgLookupPanic id
   = do	static_binds <- getStaticBinds
 	local_binds <- getBinds
-	srt <- getSRTLabel
-	pprPanic "StgCmmEnv: variable not found"
+        pprPanic "StgCmmEnv: variable not found"
 		(vcat [ppr id,
 		ptext (sLit "static binds for:"),
 		vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
 		ptext (sLit "local binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
-	        ptext (sLit "SRT label") <+> ppr srt
-	      ])
+                vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
+              ])
 
 
 --------------------
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 2290914310..39bd1feef1 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -39,8 +39,7 @@ module StgCmmMonad (
         Sequel(..), ReturnKind(..),
 	withSequel, getSequel,
 
-	setSRTLabel, getSRTLabel, 
-	setTickyCtrLabel, getTickyCtrLabel,
+        setTickyCtrLabel, getTickyCtrLabel,
 
 	withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,
 
@@ -155,8 +154,7 @@ data CgInfoDownwards	-- information only passed *downwards* by the monad
 	cgd_dflags     :: DynFlags,
 	cgd_mod        :: Module,	  -- Module being compiled
 	cgd_statics    :: CgBindings,	  -- [Id -> info] : static environment
-	cgd_srt_lbl    :: CLabel,	  -- Label of the current top-level SRT
-	cgd_updfr_off  :: UpdFrameOffset, -- Size of current update frame
+        cgd_updfr_off  :: UpdFrameOffset, -- Size of current update frame
 	cgd_ticky      :: CLabel,	  -- Current destination for ticky counts
 	cgd_sequel     :: Sequel	  -- What to do at end of basic block
   }
@@ -285,8 +283,7 @@ initCgInfoDown dflags mod
   = MkCgInfoDown {	cgd_dflags    = dflags,
 			cgd_mod       = mod,
 			cgd_statics   = emptyVarEnv,
-			cgd_srt_lbl   = error "initC: srt_lbl",
-			cgd_updfr_off = initUpdFrameOff,
+                        cgd_updfr_off = initUpdFrameOff,
 			cgd_ticky     = mkTopTickyCtrLabel,
 			cgd_sequel    = initSequel }
 
@@ -472,22 +469,6 @@ getSequel = do  { info <- getInfoDown
 		; return (cgd_sequel info) }
 
 -- ----------------------------------------------------------------------------
--- Get/set the current SRT label
-
--- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
--- the nested bindings via the monad.
-
-getSRTLabel :: FCode CLabel	-- Used only by cgPanic
-getSRTLabel = do info  <- getInfoDown
-		 return (cgd_srt_lbl info)
-
-setSRTLabel :: CLabel -> FCode a -> FCode a
-setSRTLabel srt_lbl code
-  = do  info <- getInfoDown
-	withInfoDown code (info { cgd_srt_lbl = srt_lbl})
-
--- ----------------------------------------------------------------------------
 -- Get/set the size of the update frame
 
 -- We keep track of the size of the update frame so that we
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 22684126c2..6f9745dbfc 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1399,7 +1399,9 @@ tryNewCodeGen hsc_env this_mod data_tycons
     -- We are building a single SRT for the entire module, so
     -- we must thread it through all the procedures as we cps-convert them.
     us <- mkSplitUniqSupply 'S'
-    let initTopSRT = initUs_ us emptySRT
+    let srt_mod | dopt Opt_SplitObjs dflags = Just this_mod
+                | otherwise                 = Nothing
+        initTopSRT = initUs_ us (emptySRT srt_mod)
 
     let run_pipeline topSRT cmmgroup = do
            (topSRT, cmmgroup) <- cmmPipeline hsc_env topSRT cmmgroup