Commit dc7a9364 authored by Simon Marlow's avatar Simon Marlow

Avoid calling toInfoLbl on the entry label (#7313)

parent 2471a6ba
...@@ -234,9 +234,10 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap ...@@ -234,9 +234,10 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
-- the proc point is a callPP) -- the proc point is a callPP)
-- Due to common blockification, we may overestimate the set of procpoints. -- Due to common blockification, we may overestimate the set of procpoints.
let add_label map pp = mapInsert pp lbls map let add_label map pp = mapInsert pp lbls map
where lbls | pp == entry = (entry_label, Just (toInfoLbl entry_label)) where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))
| otherwise = (blockLbl pp, guard (setMember pp callPPs) >> | otherwise = (block_lbl, guard (setMember pp callPPs) >>
Just (infoTblLbl pp)) Just (toInfoLbl block_lbl))
where block_lbl = blockLbl pp
procLabels :: LabelMap (CLabel, Maybe CLabel) procLabels :: LabelMap (CLabel, Maybe CLabel)
procLabels = foldl add_label mapEmpty procLabels = foldl add_label mapEmpty
...@@ -288,23 +289,25 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap ...@@ -288,23 +289,25 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
graphEnv <- foldM add_jumps emptyBlockMap $ mapToList graphEnv graphEnv <- foldM add_jumps emptyBlockMap $ mapToList graphEnv
let to_proc (bid, g) = case expectJust "pp label" $ mapLookup bid procLabels of let to_proc (bid, g)
(lbl, Just info_lbl) | bid == entry
| bid == entry = CmmProc (TopInfo {info_tbls = info_tbls,
-> CmmProc (TopInfo {info_tbls = info_tbls, stack_info = stack_info})
stack_info = stack_info}) top_l (replacePPIds g)
top_l (replacePPIds g) | otherwise
| otherwise = case expectJust "pp label" $ mapLookup bid procLabels of
-> CmmProc (TopInfo {info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl), stack_info=stack_info}) (lbl, Just info_lbl)
lbl (replacePPIds g) -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
(lbl, Nothing) , stack_info=stack_info})
-> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info}) lbl (replacePPIds g)
lbl (replacePPIds g) (lbl, Nothing)
where -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
stack_info = StackInfo { arg_space = 0 lbl (replacePPIds g)
, updfr_space = Nothing where
, do_layout = True } stack_info = StackInfo { arg_space = 0
-- cannot use panic, this is printed by -ddump-cmmz , updfr_space = Nothing
, do_layout = True }
-- cannot use panic, this is printed by -ddump-cmmz
-- References to procpoint IDs can now be replaced with the -- References to procpoint IDs can now be replaced with the
-- infotable's label -- infotable's label
......
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