Commit bd5354e3 authored by Simon Marlow's avatar Simon Marlow

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.
parent e6411395
......@@ -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')
......
......@@ -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
......
......@@ -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)
......
......@@ -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 ]
])
--------------------
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment