Commit ceffd7fe authored by Ben Gamari's avatar Ben Gamari 🐢

Revert "An overhaul of the SRT representation"

This reverts commit eb8e692c.
parent dee22948
......@@ -14,11 +14,12 @@ module CLabel (
pprDebugCLabel,
mkClosureLabel,
mkSRTLabel,
mkTopSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkRednCountsLabel,
mkConInfoTableLabel,
mkLargeSRTLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
......@@ -53,7 +54,6 @@ module CLabel (
mkSMAP_DIRTY_infoLabel,
mkBadAlignmentLabel,
mkArrWords_infoLabel,
mkSRTInfoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
......@@ -250,7 +250,10 @@ data CLabel
| HpcTicksLabel Module
-- | Static reference table
| SRTLabel
| SRTLabel !Unique
-- | Label of an StgLargeSRT
| LargeSRTLabel
{-# UNPACK #-} !Unique
-- | A bitmap (function or case return)
......@@ -300,6 +303,8 @@ 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
......@@ -332,6 +337,8 @@ 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
......@@ -380,6 +387,9 @@ 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
......@@ -449,8 +459,8 @@ data DynamicLinkerLabelInfo
-- Constructing IdLabels
-- These are always local:
mkSRTLabel :: Unique -> CLabel
mkSRTLabel u = SRTLabel u
mkTopSRTLabel :: Unique -> CLabel
mkTopSRTLabel u = SRTLabel u
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel name =
......@@ -508,29 +518,6 @@ mkSMAP_FROZEN_DIRTY_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
......@@ -615,6 +602,9 @@ isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True
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
isSomeRODataLabel _lbl = False
......@@ -626,7 +616,9 @@ foreignLabelStdcallInfo _lbl = Nothing
-- Constructing Large*Labels
mkLargeSRTLabel :: Unique -> CLabel
mkBitmapLabel :: Unique -> CLabel
mkLargeSRTLabel uniq = LargeSRTLabel uniq
mkBitmapLabel uniq = LargeBitmapLabel uniq
-- Constructing Cost Center Labels
......@@ -684,6 +676,8 @@ 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)
......@@ -752,6 +746,7 @@ 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
......@@ -898,10 +893,12 @@ 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
......@@ -957,6 +954,7 @@ labelType (DynamicLinkerLabel _ _) = DataLabel -- Is this right?
labelType PicBaseLabel = DataLabel
labelType (DeadStripPreventer _) = DataLabel
labelType (HpcTicksLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
idInfoLabelType :: IdLabelInfo -> CLabelType
......@@ -1045,6 +1043,7 @@ 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
......@@ -1183,6 +1182,7 @@ 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
......@@ -1275,6 +1275,7 @@ 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,6 +18,7 @@ module Cmm (
-- * Info Tables
CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
ClosureTypeInfo(..),
C_SRT(..), needsSRT,
ProfilingInfo(..), ConstrDescription,
-- * Statements, expressions and types
......@@ -137,13 +138,24 @@ data CmmInfoTable
cit_lbl :: CLabel, -- Info table label
cit_rep :: SMRep,
cit_prof :: ProfilingInfo,
cit_srt :: Maybe CLabel -- empty, or a closure address
cit_srt :: C_SRT
}
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 = Nothing }
, cit_srt = NoC_SRT }
cmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()
-> IO (Stream IO RawCmmGroup ())
......@@ -255,11 +255,12 @@ packIntsCLit dflags a b = packHalfWordsCLit dflags
mkSRTLit :: DynFlags
-> Maybe CLabel
-> C_SRT
-> ([CmmLit], -- srt_label, if any
StgHalfWord) -- srt_bitmap
mkSRTLit dflags Nothing = ([], toStgHalfWord dflags 0)
mkSRTLit dflags (Just lbl) = ([CmmLabel lbl], toStgHalfWord dflags 1)
mkSRTLit dflags NoC_SRT = ([], toStgHalfWord dflags 0)
mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
-------------------------------------------------------------------------
--
......
......@@ -470,7 +470,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
[]) }
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
......@@ -486,7 +486,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
[]) }
-- we leave most of the fields zero here. This is only used
-- to generate the BCO info table in the RTS at the moment.
......@@ -504,7 +504,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
[]) }
-- If profiling is on, this string gets duplicated,
......@@ -521,7 +521,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
......@@ -532,7 +532,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
......@@ -547,7 +547,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 = Nothing },
, cit_prof = prof, cit_srt = NoC_SRT },
live) }
body :: { CmmParse () }
......
......@@ -32,22 +32,21 @@ import Platform
-- | Top level driver for C-- pipeline
-----------------------------------------------------------------------------
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 =
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 =
do let dflags = hsc_dflags hsc_env
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
(srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags srtInfo tops
(topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" (ppr cmms)
return (srtInfo, cmms)
return (topSRT, cmms)
cpsTop :: HscEnv -> CmmDecl -> IO (CAFEnv, [CmmDecl])
......@@ -106,7 +105,7 @@ cpsTop hsc_env proc =
Opt_D_dump_cmm_sink "Sink assignments"
------------- CAF analysis ----------------------------------------------
let cafEnv = {-# SCC "cafAnal" #-} cafAnal call_pps l g
let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" (ppr cafEnv)
g <- if splitting_proc_points
......
......@@ -30,7 +30,6 @@ module Hoopl.Dataflow
, rewriteCmmBwd
, changedIf
, joinOutFacts
, joinFacts
)
where
......@@ -375,11 +374,6 @@ 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_tbls: " <> ppr info_tbl,
vcat [text "info_tbl: " <> ppr info_tbl,
text "stack_info: " <> ppr stack_info]
----------------------------------------------------------
......
......@@ -115,15 +115,18 @@ 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 ]
, text "srt: " <> ppr srt ]
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)
instance Outputable ForeignHint where
ppr NoHint = empty
......
......@@ -750,7 +750,7 @@ mkCmmInfo ClosureInfo {..}
= CmmInfoTable { cit_lbl = closureInfoLabel
, cit_rep = closureSMRep
, cit_prof = closureProf
, cit_srt = Nothing }
, cit_srt = NoC_SRT }
--------------------------------------
-- Building ClosureInfos
......@@ -1035,7 +1035,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 = Nothing }
, cit_srt = NoC_SRT }
where
name = dataConName data_con
info_lbl = mkConInfoTableLabel name NoCafRefs
......@@ -1058,14 +1058,14 @@ cafBlackHoleInfoTable
= CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
, cit_rep = blackHoleRep
, cit_prof = NoProfilingInfo
, cit_srt = Nothing }
, cit_srt = NoC_SRT }
indStaticInfoTable :: CmmInfoTable
indStaticInfoTable
= CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
, cit_rep = indStaticRep
, cit_prof = NoProfilingInfo
, cit_srt = Nothing }
, cit_srt = NoC_SRT }
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- A static closure needs a link field to aid the GC when traversing
......@@ -1076,4 +1076,4 @@ staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- of the SRT.
staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
| isConRep smrep = not (isStaticNoCafCon smrep)
| otherwise = has_srt
| otherwise = has_srt -- needsSRT (cit_srt info_tbl)
......@@ -1397,13 +1397,15 @@ 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 ()
......@@ -1454,17 +1456,21 @@ doCodeGen hsc_env this_mod data_tycons
osSubsectionsViaSymbols (platformOS (targetPlatform dflags))
= {-# SCC "cmmPipeline" #-}
let run_pipeline us cmmgroup = do
(_topSRT, cmmgroup) <-
cmmPipeline hsc_env (emptySRT this_mod) cmmgroup
return (us, cmmgroup)
let (topSRT', us') = initUs us emptySRT
(topSRT, cmmgroup) <- cmmPipeline hsc_env topSRT' cmmgroup
let srt | isEmptySRT topSRT = []
| otherwise = srtToData topSRT
return (us', srt ++ cmmgroup)
in do _ <- Stream.mapAccumL run_pipeline us ppr_stream1
return ()
| otherwise
= {-# SCC "cmmPipeline" #-}
let run_pipeline = cmmPipeline hsc_env
in void $ Stream.mapAccumL run_pipeline (emptySRT this_mod) ppr_stream1
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
dump2 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm
......
......@@ -131,6 +131,15 @@ 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)->has_srt;
return get_itbl(con)->srt_bitmap;
}
/* -----------------------------------------------------------------------------
......
......@@ -124,6 +124,31 @@ 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
------------------------------------------------------------------------- */
......@@ -169,11 +194,11 @@ typedef struct StgInfoTable_ {
StgClosureInfo layout; /* closure layout info (one word) */
StgHalfWord type; /* closure type */
StgHalfWord has_srt;
StgHalfWord srt_bitmap;
/* In a CONSTR:
- the constructor tag
In a FUN/THUNK
- non-zero if there is an SRT
- a bitmap of SRT entries
*/
#if defined(TABLES_NEXT_TO_CODE)
......@@ -192,7 +217,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 has_srt (in the std info table part) is zero, then the srt
- If srt_bitmap (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.
-------------------------------------------------------------------------- */
......@@ -214,7 +239,7 @@ typedef struct StgFunInfoExtraRev_ {
StgWord bitmap;
OFFSET_FIELD(bitmap_offset); /* arg ptr/nonptr bitmap */
} b;
OFFSET_FIELD(srt_offset); /* pointer to the SRT closure */
OFFSET_FIELD(srt_offset); /* pointer to the SRT table */
StgHalfWord fun_type; /* function type */
StgHalfWord arity; /* function arity */
} StgFunInfoExtraRev;
......@@ -222,7 +247,7 @@ typedef struct StgFunInfoExtraRev_ {
typedef struct StgFunInfoExtraFwd_ {
StgHalfWord fun_type; /* function type */
StgHalfWord arity; /* function arity */
StgClosure *srt; /* pointer to the SRT closure */
StgSRT *srt; /* pointer to the SRT table */
union { /* union for compat. with TABLES_NEXT_TO_CODE version */
StgWord bitmap; /* arg ptr/nonptr bitmap */
} b;
......@@ -248,16 +273,16 @@ extern const StgWord stg_arg_bitmaps[];
/*
* When info tables are laid out backwards, we can omit the SRT
* pointer iff has_srt is zero.
* pointer iff srt_bitmap is zero.
*/
typedef struct {
#if defined(TABLES_NEXT_TO_CODE)
OFFSET_FIELD(srt_offset); /* offset to the SRT closure */
OFFSET_FIELD(srt_offset); /* offset to the SRT table */
StgInfoTable i;
#else
StgInfoTable i;
StgClosure *srt; /* pointer to the SRT closure */
StgSRT *srt; /* pointer to the SRT table */
#endif
} StgRetInfoTable;
......@@ -267,7 +292,7 @@ typedef struct {
/*
* When info tables are laid out backwards, we can omit the SRT
* pointer iff has_srt is zero.
* pointer iff srt_bitmap is zero.
*/
typedef struct StgThunkInfoTable_ {
......@@ -275,9 +300,9 @@ typedef struct StgThunkInfoTable_ {
StgInfoTable i;
#endif
#if defined(TABLES_NEXT_TO_CODE)
OFFSET_FIELD(srt_offset); /* offset to the SRT closure */
OFFSET_FIELD(srt_offset); /* offset to the SRT table */
#else
StgClosure *srt; /* pointer to the SRT closure */
StgSRT *srt; /* pointer to the SRT table */
#endif
#if defined(TABLES_NEXT_TO_CODE)
StgInfoTable i;
......@@ -315,8 +340,7 @@ 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) \
((StgClosure*) (((StgWord) ((info)+1)) + (info)->srt_offset))
#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset))
#else
#define GET_SRT(info) ((info)->srt)
#endif
......@@ -337,8 +361,7 @@ typedef struct StgConInfoTable_ {
* info must be a StgFunInfoTable*
*/
#if defined(TABLES_NEXT_TO_CODE)
#define GET_FUN_SRT(info) \
((StgClosure*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
#else
#define GET_FUN_SRT(info) ((info)->f.srt)
#endif
......
......@@ -150,22 +150,6 @@ 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 */
......
......@@ -37,11 +37,7 @@ peekItbl a0 = do
ptrs' <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr
nptrs' <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr
tipe' <- (#peek struct StgInfoTable_, type) ptr
#if __GLASGOW_HASKELL__ > 804
srtlen' <- (#peek struct StgInfoTable_, has_srt) a0
#else
srtlen' <- (#peek struct StgInfoTable_, srt_bitmap) ptr
#endif
return StgInfoTable
{ entry = entry'
, ptrs = ptrs'
......@@ -59,11 +55,7 @@ pokeItbl a0 itbl = do
(#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)
(#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)
(#poke StgInfoTable, type) a0 (fromEnum (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
......
......@@ -34,11 +34,7 @@ peekItbl a0 = do
ptrs' <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr
nptrs' <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr
tipe' <- (#peek struct StgInfoTable_, type) ptr
#if __GLASGOW_HASKELL__ > 804
srtlen' <- (#peek struct StgInfoTable_, has_srt) a0
#else
srtlen' <- (#peek struct StgInfoTable_, srt_bitmap) ptr
#endif
return StgInfoTable
{ entry = entry'
, ptrs = ptrs'
......@@ -56,11 +52,7 @@ pokeItbl a0 itbl = do
(#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)
(#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)
(#poke StgInfoTable, type) a0 (fromEnum (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->has_srt == 0) { // has_srt is the constructor tag
if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
return 0;
} else {
return 1;
......
......@@ -775,22 +775,6 @@
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) \
<