Commit eb8e692c authored by Simon Marlow's avatar Simon Marlow

An overhaul of the SRT representation

Summary:
- Previously we would hvae a single big table of pointers per module,
  with a set of bitmaps to reference entries within it. The new
  representation is identical to a static constructor, which is much
  simpler for the GC to traverse, and we get to remove the complicated
  bitmap-traversal code from the GC.

- Rewrite all the code to generate SRTs in CmmBuildInfoTables, and
  document it much better (see Note [SRTs]). This has been something
  I've wanted to do since we moved to the new code generator, I
  finally had the opportunity to finish it while on a transatlantic
  flight recently :)

There are a series of 4 diffs:

1. D4632 (this one), which does the bulk of the changes

2. D4633 which adds support for smaller `CmmLabelDiffOff` constants

3. D4634 which takes advantage of D4632 and D4633 to save a word in
   info tables that have an SRT on x86_64. This is where most of the
   binary size improvement comes from.

4. D4637 which makes a further optimisation to merge some SRTs with
   static FUN closures.  This adds some complexity and the benefits
   are fairly modest, so it's not clear yet whether we should do this.

Results (after (3), on x86_64)

- GHC itself (staticaly linked) is 5.2% smaller

- -1.7% binary sizes in nofib, -2.9% module sizes. Full nofib results: P176

- I measured the overhead of traversing all the static objects in a
  major GC in GHC itself by doing `replicateM_ 1000 performGC` as the
  first thing in `Main.main`.  The new version was 5-10% faster, but
  the results did vary quite a bit.

- I'm not sure if there's a compile-time difference, the results are
  too unreliable.

Test Plan: validate

Reviewers: bgamari, michalt, niteria, simonpj, erikd, osa1

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D4632
parent a18e7dfa
......@@ -14,12 +14,11 @@ module CLabel (
pprDebugCLabel,
mkClosureLabel,
mkTopSRTLabel,
mkSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkRednCountsLabel,
mkConInfoTableLabel,
mkLargeSRTLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
......@@ -54,6 +53,7 @@ module CLabel (
mkSMAP_DIRTY_infoLabel,
mkBadAlignmentLabel,
mkArrWords_infoLabel,
mkSRTInfoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
......@@ -250,10 +250,7 @@ data CLabel
| HpcTicksLabel Module
-- | Static reference table
| SRTLabel !Unique
-- | Label of an StgLargeSRT
| LargeSRTLabel
| SRTLabel
{-# UNPACK #-} !Unique
-- | A bitmap (function or case return)
......@@ -303,8 +300,6 @@ instance Ord CLabel where
compare a1 a2
compare (SRTLabel u1) (SRTLabel u2) =
nonDetCmpUnique u1 u2
compare (LargeSRTLabel u1) (LargeSRTLabel u2) =
nonDetCmpUnique u1 u2
compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
nonDetCmpUnique u1 u2
compare IdLabel{} _ = LT
......@@ -337,8 +332,6 @@ instance Ord CLabel where
compare _ HpcTicksLabel{} = GT
compare SRTLabel{} _ = LT
compare _ SRTLabel{} = GT
compare LargeSRTLabel{} _ = LT
compare _ LargeSRTLabel{} = GT
-- | Record where a foreign label is stored.
data ForeignLabelSource
......@@ -387,9 +380,6 @@ pprDebugCLabel lbl
data IdLabelInfo
= Closure -- ^ Label for closure
| 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
......@@ -459,8 +449,8 @@ data DynamicLinkerLabelInfo
-- Constructing IdLabels
-- These are always local:
mkTopSRTLabel :: Unique -> CLabel
mkTopSRTLabel u = SRTLabel u
mkSRTLabel :: Unique -> CLabel
mkSRTLabel u = SRTLabel u
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel name =
......@@ -517,6 +507,29 @@ mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_P
mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
mkBadAlignmentLabel = CmmLabel rtsUnitId (fsLit "stg_badAlignment") CmmEntry
mkSRTInfoLabel :: Int -> CLabel
mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
where
lbl =
case n of
1 -> fsLit "stg_SRT_1"
2 -> fsLit "stg_SRT_2"
3 -> fsLit "stg_SRT_3"
4 -> fsLit "stg_SRT_4"
5 -> fsLit "stg_SRT_5"
6 -> fsLit "stg_SRT_6"
7 -> fsLit "stg_SRT_7"
8 -> fsLit "stg_SRT_8"
9 -> fsLit "stg_SRT_9"
10 -> fsLit "stg_SRT_10"
11 -> fsLit "stg_SRT_11"
12 -> fsLit "stg_SRT_12"
13 -> fsLit "stg_SRT_13"
14 -> fsLit "stg_SRT_14"
15 -> fsLit "stg_SRT_15"
16 -> fsLit "stg_SRT_16"
_ -> panic "mkSRTInfoLabel"
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
......@@ -602,7 +615,6 @@ isSomeRODataLabel (IdLabel _ _ InfoTable) = True
isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
-- static reference tables defined in haskell (.hs)
isSomeRODataLabel (IdLabel _ _ SRT) = True
isSomeRODataLabel (SRTLabel _) = True
-- info table defined in cmm (.cmm)
isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
......@@ -615,9 +627,7 @@ foreignLabelStdcallInfo _lbl = Nothing
-- Constructing Large*Labels
mkLargeSRTLabel :: Unique -> CLabel
mkBitmapLabel :: Unique -> CLabel
mkLargeSRTLabel uniq = LargeSRTLabel uniq
mkBitmapLabel uniq = LargeBitmapLabel uniq
-- Constructing Cost Center Labels
......@@ -675,8 +685,6 @@ mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
-- Convert between different kinds of label
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel n _ BlockInfoTable)
= pprPanic "toClosureLbl: BlockInfoTable" (ppr n)
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
......@@ -745,7 +753,6 @@ needsCDecl :: CLabel -> Bool
-- don't bother declaring Bitmap labels, we always make sure
-- they are defined before use.
needsCDecl (SRTLabel _) = True
needsCDecl (LargeSRTLabel _) = False
needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _ _) = True
needsCDecl (LocalBlockLabel _) = True
......@@ -892,12 +899,10 @@ externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (SRTLabel _) = False
externallyVisibleCLabel (LargeSRTLabel _) = False
externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
externallyVisibleIdLabel :: IdLabelInfo -> Bool
externallyVisibleIdLabel SRT = False
externallyVisibleIdLabel LocalInfoTable = False
externallyVisibleIdLabel LocalEntry = False
externallyVisibleIdLabel BlockInfoTable = False
......@@ -953,7 +958,6 @@ labelType (DynamicLinkerLabel _ _) = DataLabel -- Is this right?
labelType PicBaseLabel = DataLabel
labelType (DeadStripPreventer _) = DataLabel
labelType (HpcTicksLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
idInfoLabelType :: IdLabelInfo -> CLabelType
......@@ -1042,7 +1046,6 @@ internal names. <type> is one of the following:
info Info table
srt Static reference table
srtd Static reference table descriptor
entry Entry code (function, closure)
slow Slow entry code (if any)
ret Direct return address
......@@ -1181,7 +1184,6 @@ pprCLbl (StringLitLabel u)
pprCLbl (SRTLabel u)
= pprUniqueAlways u <> pp_cSEP <> text "srt"
pprCLbl (LargeSRTLabel u) = pprUniqueAlways u <> pp_cSEP <> text "srtd"
pprCLbl (LargeBitmapLabel u) = text "b" <> pprUniqueAlways u <> pp_cSEP <> text "btm"
-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
-- until that gets resolved we'll just force them to start
......@@ -1274,7 +1276,6 @@ ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
(case x of
Closure -> text "closure"
SRT -> text "srt"
InfoTable -> text "info"
LocalInfoTable -> text "info"
Entry -> text "entry"
......
......@@ -18,7 +18,6 @@ module Cmm (
-- * Info Tables
CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
ClosureTypeInfo(..),
C_SRT(..), needsSRT,
ProfilingInfo(..), ConstrDescription,
-- * Statements, expressions and types
......@@ -138,24 +137,13 @@ data CmmInfoTable
cit_lbl :: CLabel, -- Info table label
cit_rep :: SMRep,
cit_prof :: ProfilingInfo,
cit_srt :: C_SRT
cit_srt :: Maybe CLabel -- empty, or a closure address
}
data ProfilingInfo
= NoProfilingInfo
| ProfilingInfo [Word8] [Word8] -- closure_type, closure_desc
-- C_SRT is what StgSyn.SRT gets translated to...
-- we add a label for the table, and expect only the 'offset/length' form
data C_SRT = NoC_SRT
| C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
deriving (Eq)
needsSRT :: C_SRT -> Bool
needsSRT NoC_SRT = False
needsSRT (C_SRT _ _ _) = True
-----------------------------------------------------------------------------
-- Static Data
-----------------------------------------------------------------------------
......
This diff is collapsed.
......@@ -62,7 +62,7 @@ mkEmptyContInfoTable info_lbl
= CmmInfoTable { cit_lbl = info_lbl
, cit_rep = mkStackRep []
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
, cit_srt = Nothing }
cmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()
-> IO (Stream IO RawCmmGroup ())
......@@ -255,12 +255,11 @@ packIntsCLit dflags a b = packHalfWordsCLit dflags
mkSRTLit :: DynFlags
-> C_SRT
-> Maybe CLabel
-> ([CmmLit], -- srt_label, if any
StgHalfWord) -- srt_bitmap
mkSRTLit dflags NoC_SRT = ([], toStgHalfWord dflags 0)
mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
mkSRTLit dflags Nothing = ([], toStgHalfWord dflags 0)
mkSRTLit dflags (Just lbl) = ([CmmLabel lbl], toStgHalfWord dflags 1)
-------------------------------------------------------------------------
--
......
......@@ -472,7 +472,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
[]) }
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
......@@ -488,7 +488,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
[]) }
-- we leave most of the fields zero here. This is only used
-- to generate the BCO info table in the RTS at the moment.
......@@ -506,7 +506,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
[]) }
-- If profiling is on, this string gets duplicated,
......@@ -523,7 +523,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
......@@ -534,7 +534,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmRetLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
......@@ -549,7 +549,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
return (mkCmmRetLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = NoC_SRT },
, cit_prof = prof, cit_srt = Nothing },
live) }
body :: { CmmParse () }
......
......@@ -32,21 +32,22 @@ import Platform
-- | Top level driver for C-- pipeline
-----------------------------------------------------------------------------
cmmPipeline :: HscEnv -- Compilation env including
-- dynamic flags: -dcmm-lint -ddump-cmm-cps
-> TopSRT -- SRT table and accumulating list of compiled procs
-> CmmGroup -- Input C-- with Procedures
-> IO (TopSRT, CmmGroup) -- Output CPS transformed C--
cmmPipeline hsc_env topSRT prog =
cmmPipeline
:: HscEnv -- Compilation env including
-- dynamic flags: -dcmm-lint -ddump-cmm-cps
-> ModuleSRTInfo -- Info about SRTs generated so far
-> CmmGroup -- Input C-- with Procedures
-> IO (ModuleSRTInfo, CmmGroup) -- Output CPS transformed C--
cmmPipeline hsc_env srtInfo prog =
do let dflags = hsc_dflags hsc_env
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
(topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
(srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags srtInfo tops
dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" (ppr cmms)
return (topSRT, cmms)
return (srtInfo, cmms)
cpsTop :: HscEnv -> CmmDecl -> IO (CAFEnv, [CmmDecl])
......@@ -105,7 +106,7 @@ cpsTop hsc_env proc =
Opt_D_dump_cmm_sink "Sink assignments"
------------- CAF analysis ----------------------------------------------
let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
let cafEnv = {-# SCC "cafAnal" #-} cafAnal call_pps l g
dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" (ppr cafEnv)
g <- if splitting_proc_points
......
......@@ -30,6 +30,7 @@ module Hoopl.Dataflow
, rewriteCmmBwd
, changedIf
, joinOutFacts
, joinFacts
)
where
......@@ -374,6 +375,11 @@ joinOutFacts lattice nonLocal fact_base = foldl' join (fact_bot lattice) facts
, isJust fact
]
joinFacts :: DataflowLattice f -> [f] -> f
joinFacts lattice facts = foldl' join (fact_bot lattice) facts
where
join new old = getJoined $ fact_join lattice (OldFact old) (NewFact new)
-- | Returns the joined facts for each label.
mkFactBase :: DataflowLattice f -> [(Label, f)] -> FactBase f
mkFactBase lattice = foldl' add mapEmpty
......
......@@ -108,7 +108,7 @@ pprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =
pprTopInfo :: CmmTopInfo -> SDoc
pprTopInfo (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
vcat [text "info_tbl: " <> ppr info_tbl,
vcat [text "info_tbls: " <> ppr info_tbl,
text "stack_info: " <> ppr stack_info]
----------------------------------------------------------
......
......@@ -115,18 +115,15 @@ pprTop (CmmData section ds) =
pprInfoTable :: CmmInfoTable -> SDoc
pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
, cit_prof = prof_info
, cit_srt = _srt })
= vcat [ text "label:" <+> ppr lbl
, text "rep:" <> ppr rep
, cit_srt = srt })
= vcat [ text "label: " <> ppr lbl
, text "rep: " <> ppr rep
, case prof_info of
NoProfilingInfo -> empty
ProfilingInfo ct cd -> vcat [ text "type:" <+> pprWord8String ct
, text "desc: " <> pprWord8String cd ] ]
instance Outputable C_SRT where
ppr NoC_SRT = text "_no_srt_"
ppr (C_SRT label off bitmap)
= parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
ProfilingInfo ct cd ->
vcat [ text "type: " <> pprWord8String ct
, text "desc: " <> pprWord8String cd ]
, text "srt: " <> ppr srt ]
instance Outputable ForeignHint where
ppr NoHint = empty
......
......@@ -755,7 +755,7 @@ mkCmmInfo ClosureInfo {..}
= CmmInfoTable { cit_lbl = closureInfoLabel
, cit_rep = closureSMRep
, cit_prof = closureProf
, cit_srt = NoC_SRT }
, cit_srt = Nothing }
--------------------------------------
-- Building ClosureInfos
......@@ -1040,7 +1040,7 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
= CmmInfoTable { cit_lbl = info_lbl
, cit_rep = sm_rep
, cit_prof = prof
, cit_srt = NoC_SRT }
, cit_srt = Nothing }
where
name = dataConName data_con
info_lbl = mkConInfoTableLabel name NoCafRefs
......@@ -1063,14 +1063,14 @@ cafBlackHoleInfoTable
= CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
, cit_rep = blackHoleRep
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
, cit_srt = Nothing }
indStaticInfoTable :: CmmInfoTable
indStaticInfoTable
= CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
, cit_rep = indStaticRep
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
, cit_srt = Nothing }
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- A static closure needs a link field to aid the GC when traversing
......@@ -1081,4 +1081,4 @@ staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- of the SRT.
staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
| isConRep smrep = not (isStaticNoCafCon smrep)
| otherwise = has_srt -- needsSRT (cit_srt info_tbl)
| otherwise = has_srt
......@@ -1397,15 +1397,13 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
let dflags = hsc_dflags hsc_env
cmm <- ioMsgMaybe $ parseCmmFile dflags filename
liftIO $ do
us <- mkSplitUniqSupply 'S'
let initTopSRT = initUs_ us emptySRT
dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose "Parsed Cmm" (ppr cmm)
(_, cmmgroup) <- cmmPipeline hsc_env initTopSRT cmm
rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup)
let -- Make up a module name to give the NCG. We can't pass bottom here
-- lest we reproduce #11784.
mod_name = mkModuleName $ "Cmm$" ++ FilePath.takeFileName filename
cmm_mod = mkModule (thisPackage dflags) mod_name
(_, cmmgroup) <- cmmPipeline hsc_env (emptySRT cmm_mod) cmm
rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup)
_ <- codeOutput dflags cmm_mod output_filename no_loc NoStubs [] []
rawCmms
return ()
......@@ -1456,21 +1454,17 @@ doCodeGen hsc_env this_mod data_tycons
osSubsectionsViaSymbols (platformOS (targetPlatform dflags))
= {-# SCC "cmmPipeline" #-}
let run_pipeline us cmmgroup = do
let (topSRT', us') = initUs us emptySRT
(topSRT, cmmgroup) <- cmmPipeline hsc_env topSRT' cmmgroup
let srt | isEmptySRT topSRT = []
| otherwise = srtToData topSRT
return (us', srt ++ cmmgroup)
(_topSRT, cmmgroup) <-
cmmPipeline hsc_env (emptySRT this_mod) cmmgroup
return (us, cmmgroup)
in do _ <- Stream.mapAccumL run_pipeline us ppr_stream1
return ()
| otherwise
= {-# SCC "cmmPipeline" #-}
let initTopSRT = initUs_ us emptySRT
run_pipeline = cmmPipeline hsc_env
in do topSRT <- Stream.mapAccumL run_pipeline initTopSRT ppr_stream1
Stream.yield (srtToData topSRT)
let run_pipeline = cmmPipeline hsc_env
in void $ Stream.mapAccumL run_pipeline (emptySRT this_mod) ppr_stream1
let
dump2 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm
......
......@@ -131,15 +131,6 @@ import Control.Monad (liftM, ap)
--
-- The CafInfo has already been calculated during the CoreTidy pass.
--
-- During CoreToStg, we then pin onto each binding and case expression, a
-- list of Ids which represents the "live" CAFs at that point. The meaning
-- of "live" here is the same as for live variables, see above (which is
-- why it's convenient to collect CAF information here rather than elsewhere).
--
-- The later SRT pass takes these lists of Ids and uses them to construct
-- the actual nested SRTs, and replaces the lists of Ids with (offset,length)
-- pairs.
-- Note [What is a non-escaping let]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
......
......@@ -109,7 +109,7 @@ INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)
INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
{
return get_itbl(con)->srt_bitmap;
return get_itbl(con)->has_srt;
}
/* -----------------------------------------------------------------------------
......
......@@ -124,31 +124,6 @@ typedef struct {
StgWord bitmap[];
} StgLargeBitmap;
/* -----------------------------------------------------------------------------
SRTs (Static Reference Tables)
These tables are used to keep track of the static objects referred
to by the code for a closure or stack frame, so that we can follow
static data references from code and thus accurately
garbage-collect CAFs.
-------------------------------------------------------------------------- */
/* An SRT is just an array of closure pointers: */
typedef StgClosure* StgSRT[];
/*
* Each info table refers to some subset of the closure pointers in an
* SRT. It does this using a pair of an StgSRT pointer and a
* half-word bitmap. If the half-word bitmap isn't large enough, then
* we fall back to a large SRT, including an unbounded bitmap. If the
* half-word bitmap is set to all ones (0xffff), then the StgSRT
* pointer instead points to an StgLargeSRT:
*/
typedef struct StgLargeSRT_ {
StgSRT *srt;
StgLargeBitmap l;
} StgLargeSRT;
/* ----------------------------------------------------------------------------
Info Tables
------------------------------------------------------------------------- */
......@@ -194,11 +169,11 @@ typedef struct StgInfoTable_ {
StgClosureInfo layout; /* closure layout info (one word) */
StgHalfWord type; /* closure type */
StgHalfWord srt_bitmap;
StgHalfWord has_srt;
/* In a CONSTR:
- the constructor tag
In a FUN/THUNK
- a bitmap of SRT entries
- non-zero if there is an SRT
*/
#if defined(TABLES_NEXT_TO_CODE)
......@@ -217,7 +192,7 @@ typedef struct StgInfoTable_ {
and bitmap fields may be left out (they are at the end, so omitting
them doesn't affect the layout).
- If srt_bitmap (in the std info table part) is zero, then the srt
- If has_srt (in the std info table part) is zero, then the srt
field needn't be set. This only applies if the slow_apply and
bitmap fields have also been omitted.
-------------------------------------------------------------------------- */
......@@ -239,7 +214,7 @@ typedef struct StgFunInfoExtraRev_ {
StgWord bitmap;
OFFSET_FIELD(bitmap_offset); /* arg ptr/nonptr bitmap */
} b;
OFFSET_FIELD(srt_offset); /* pointer to the SRT table */
OFFSET_FIELD(srt_offset); /* pointer to the SRT closure */
StgHalfWord fun_type; /* function type */
StgHalfWord arity; /* function arity */
} StgFunInfoExtraRev;
......@@ -247,7 +222,7 @@ typedef struct StgFunInfoExtraRev_ {
typedef struct StgFunInfoExtraFwd_ {
StgHalfWord fun_type; /* function type */
StgHalfWord arity; /* function arity */
StgSRT *srt; /* pointer to the SRT table */
StgClosure *srt; /* pointer to the SRT closure */
union { /* union for compat. with TABLES_NEXT_TO_CODE version */
StgWord bitmap; /* arg ptr/nonptr bitmap */
} b;
......@@ -273,16 +248,16 @@ extern const StgWord stg_arg_bitmaps[];
/*
* When info tables are laid out backwards, we can omit the SRT
* pointer iff srt_bitmap is zero.
* pointer iff has_srt is zero.
*/
typedef struct {
#if defined(TABLES_NEXT_TO_CODE)
OFFSET_FIELD(srt_offset); /* offset to the SRT table */
OFFSET_FIELD(srt_offset); /* offset to the SRT closure */
StgInfoTable i;
#else
StgInfoTable i;
StgSRT *srt; /* pointer to the SRT table */
StgClosure *srt; /* pointer to the SRT closure */
#endif
} StgRetInfoTable;
......@@ -292,7 +267,7 @@ typedef struct {
/*
* When info tables are laid out backwards, we can omit the SRT
* pointer iff srt_bitmap is zero.
* pointer iff has_srt is zero.
*/
typedef struct StgThunkInfoTable_ {
......@@ -300,9 +275,9 @@ typedef struct StgThunkInfoTable_ {
StgInfoTable i;
#endif
#if defined(TABLES_NEXT_TO_CODE)
OFFSET_FIELD(srt_offset); /* offset to the SRT table */
OFFSET_FIELD(srt_offset); /* offset to the SRT closure */
#else
StgSRT *srt; /* pointer to the SRT table */
StgClosure *srt; /* pointer to the SRT closure */
#endif
#if defined(TABLES_NEXT_TO_CODE)
StgInfoTable i;
......@@ -340,7 +315,8 @@ typedef struct StgConInfoTable_ {
* info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT)
*/
#if defined(TABLES_NEXT_TO_CODE)
#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset))
#define GET_SRT(info) \
((StgClosure*) (((StgWord) ((info)+1)) + (info)->srt_offset))
#else
#define GET_SRT(info) ((info)->srt)
#endif
......@@ -361,7 +337,8 @@ typedef struct StgConInfoTable_ {
* info must be a StgFunInfoTable*
*/
#if defined(TABLES_NEXT_TO_CODE)
#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
#define GET_FUN_SRT(info) \
((StgClosure*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
#else
#define GET_FUN_SRT(info) ((info)->f.srt)
#endif
......
......@@ -153,6 +153,22 @@ RTS_ENTRY(stg_END_STM_CHUNK_LIST);
RTS_ENTRY(stg_NO_TREC);
RTS_ENTRY(stg_COMPACT_NFDATA_CLEAN);
RTS_ENTRY(stg_COMPACT_NFDATA_DIRTY);
RTS_ENTRY(stg_SRT_1);
RTS_ENTRY(stg_SRT_2);
RTS_ENTRY(stg_SRT_3);
RTS_ENTRY(stg_SRT_4);
RTS_ENTRY(stg_SRT_5);
RTS_ENTRY(stg_SRT_6);
RTS_ENTRY(stg_SRT_7);
RTS_ENTRY(stg_SRT_8);
RTS_ENTRY(stg_SRT_9);
RTS_ENTRY(stg_SRT_10);
RTS_ENTRY(stg_SRT_11);
RTS_ENTRY(stg_SRT_12);
RTS_ENTRY(stg_SRT_13);
RTS_ENTRY(stg_SRT_14);
RTS_ENTRY(stg_SRT_15);
RTS_ENTRY(stg_SRT_16);
/* closures */
......
......@@ -57,7 +57,11 @@ peekItbl a0 = do
ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0
nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0
tipe' <- (#peek StgInfoTable, type) a0
#if __GLASGOW_HASKELL__ > 804
srtlen' <- (#peek StgInfoTable, has_srt) a0
#else
srtlen' <- (#peek StgInfoTable, srt_bitmap) a0
#endif
return StgInfoTable
{ entry = entry'
, ptrs = ptrs'
......@@ -393,7 +397,11 @@ pokeItbl a0 itbl = do
(#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)
(#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)
(#poke StgInfoTable, type) a0 (tipe itbl)
#if __GLASGOW_HASKELL__ > 804
(#poke StgInfoTable, has_srt) a0 (srtlen itbl)
#else
(#poke StgInfoTable, srt_bitmap) a0 (srtlen itbl)
#endif
#if defined(TABLES_NEXT_TO_CODE)
let code_offset = (a0 `plusPtr` (#offset StgInfoTable, code))
case code itbl of
......
......@@ -367,7 +367,7 @@ rts_getBool (HaskellObj p)
const StgInfoTable *info;
info = get_itbl((const StgClosure *)UNTAG_CONST_CLOSURE(p));
if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
if (info->has_srt == 0) { // has_srt is the constructor tag
return 0;
} else {
return 1;
......
......@@ -776,6 +776,22 @@
SymI_HasProto(stg_MUT_VAR_CLEAN_info) \
SymI_HasProto(stg_MUT_VAR_DIRTY_info) \
SymI_HasProto(stg_WEAK_info) \
SymI_HasProto(stg_SRT_1_info) \
SymI_HasProto(stg_SRT_2_info) \
SymI_HasProto(stg_SRT_3_info) \
SymI_HasProto(stg_SRT_4_info) \
SymI_HasProto(stg_SRT_5_info) \
SymI_HasProto(stg_SRT_6_info) \
SymI_HasProto(stg_SRT_7_info) \
SymI_HasProto(stg_SRT_8_info) \
SymI_HasProto(stg_SRT_9_info) \
SymI_HasProto(stg_SRT_10_info) \
SymI_HasProto(stg_SRT_11_info) \
SymI_HasProto(stg_SRT_12_info) \
SymI_HasProto(stg_SRT_13_info) \
SymI_HasProto(stg_SRT_14_info) \
SymI_HasProto(stg_SRT_15_info) \
SymI_HasProto(stg_SRT_16_info) \
SymI_HasProto(stg_ap_v_info) \
SymI_HasProto(stg_ap_f_info) \
SymI_HasProto(stg_ap_d_info) \
......
......@@ -518,7 +518,60 @@ CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
/* ----------------------------------------------------------------------------
Messages
SRTs
See Note [SRTs] in compiler/cmm/CmmBuildInfoTable.hs
------------------------------------------------------------------------- */
INFO_TABLE_CONSTR(stg_SRT_1, 1, 0, 0, CONSTR, "SRT_1", "SRT_1")
{ foreign "C" barf("SRT_1 object entered!") never returns; }
INFO_TABLE_CONSTR(stg_SRT_2, 2, 0, 0, CONSTR, "SRT_2", "SRT_2")