summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2018-05-16 14:03:55 +0100
committerSimon Marlow <marlowsd@gmail.com>2018-05-17 08:54:55 +0100
commitf2d27c1ad69321872a87a37144fe41e815301f5b (patch)
treee579648c6360411911767fbe36c402c59694890a
parent0c7db226012b5cfafc9a38bfe372661672ec8900 (diff)
downloadhaskell-f2d27c1ad69321872a87a37144fe41e815301f5b.tar.gz
Comments and refactoring only
Addressing review comments on D4637
-rw-r--r--compiler/cmm/Cmm.hs12
-rw-r--r--compiler/cmm/CmmBuildInfoTables.hs30
-rw-r--r--compiler/codeGen/StgCmmClosure.hs2
3 files changed, 31 insertions, 13 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 4c8e528250..eb34618e38 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -143,6 +143,18 @@ data CmmInfoTable
cit_clo :: Maybe (Id, CostCentreStack)
-- Just (id,ccs) <=> build a static closure later
-- Nothing <=> don't build a static closure
+ --
+ -- Static closures for FUNs and THUNKs are *not* generated by
+ -- the code generator, because we might want to add SRT
+ -- entries to them later (for FUNs at least; THUNKs are
+ -- treated the same for consistency). See Note [SRTs] in
+ -- CmmBuildInfoTables, in particular the [FUN] optimisation.
+ --
+ -- This is strictly speaking not a part of the info table that
+ -- will be finally generated, but it's the only convenient
+ -- place to convey this information from the code generator to
+ -- where we build the static closures in
+ -- CmmBuildInfoTables.doSRTs.
}
data ProfilingInfo
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index d9408df202..bef4d9867f 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -463,15 +463,16 @@ getCAFs (CmmProc top_info topLbl _ g)
-- | Get the list of blocks that correspond to the entry points for
-- FUN_STATIC closures. These are the blocks for which if we have an
-- SRT we can merge it with the static closure. [FUN]
-getStaticFuns :: CmmDecl -> [(BlockId, CLabel)]
-getStaticFuns (CmmData _ _) = []
-getStaticFuns (CmmProc top_info _ _ g)
- | Just info <- mapLookup (g_entry g) (info_tbls top_info)
+getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]
+getStaticFuns decls =
+ [ (g_entry g, lbl)
+ | CmmProc top_info _ _ g <- decls
+ , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]
+ , Just (id, _) <- [cit_clo info]
, let rep = cit_rep info
- , Just (id, _) <- cit_clo info
+ , isStaticRep rep && isFunRep rep
, let lbl = mkLocalClosureLabel (idName id) (idCafInfo id)
- , isStaticRep rep && isFunRep rep = [(g_entry g, lbl)]
- | otherwise = []
+ ]
-- | Put the labelled blocks that we will be annotating with SRTs into
@@ -527,7 +528,7 @@ doSRTs
-> [(CAFEnv, [CmmDecl])]
-> IO (ModuleSRTInfo, [CmmDecl])
-doSRTs dflags topSRT tops = do
+doSRTs dflags moduleSRTInfo tops = do
us <- mkSplitUniqSupply 'u'
-- Ignore the original grouping of decls, and combine all the
@@ -535,7 +536,7 @@ doSRTs dflags topSRT tops = do
let (cafEnvs, declss) = unzip tops
cafEnv = mapUnions cafEnvs
decls = concat declss
- staticFuns = mapFromList (concatMap getStaticFuns decls)
+ staticFuns = mapFromList (getStaticFuns decls)
-- Put the decls in dependency order. Why? So that we can implement
-- [Shortcut] and [Filter]. If we need to refer to an SRT that has
@@ -547,9 +548,14 @@ doSRTs dflags topSRT tops = do
-- On each strongly-connected group of decls, construct the SRT
-- closures and the SRT fields for info tables.
- let ((result, _srtMap), topSRT') =
+ let result ::
+ [ ( [CmmDecl] -- generated SRTs
+ , [(Label, CLabel)] -- SRT fields for info tables
+ , [(Label, [SRTEntry])] -- SRTs to attach to static functions
+ ) ]
+ ((result, _srtMap), moduleSRTInfo') =
initUs_ us $
- flip runStateT topSRT $
+ flip runStateT moduleSRTInfo $
flip runStateT Map.empty $
mapM (doSCC dflags staticFuns) sccs
@@ -561,7 +567,7 @@ doSRTs dflags topSRT tops = do
funSRTMap = mapFromList (concat funSRTs)
decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls
- return (topSRT', concat declss ++ decls')
+ return (moduleSRTInfo', concat declss ++ decls')
-- | Build the SRT for a strongly-connected component of blocks
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index e0306eeba3..b021fe070d 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -1045,7 +1045,7 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
, cit_rep = sm_rep
, cit_prof = prof
, cit_srt = Nothing
- , cit_clo = Nothing }
+ , cit_clo = Nothing }
where
name = dataConName data_con
info_lbl = mkConInfoTableLabel name NoCafRefs