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.

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')

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

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)
 
 

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 ]
+              ])
 
 
 --------------------

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 }
 
@@ -471,22 +468,6 @@ getSequel :: FCode Sequel
 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
 

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