summaryrefslogtreecommitdiff
path: root/compiler/cmm/CmmSink.hs
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2013-10-25 10:32:48 +0100
committerSimon Marlow <marlowsd@gmail.com>2013-10-25 10:32:48 +0100
commit29be1a8afa6aece04ca85060662510a14d2ff8b0 (patch)
treeb291833597147a8f66c5a9bbfd7d48df9e8e8f88 /compiler/cmm/CmmSink.hs
parent2f5db98e90cf0cff1a11971c85f108a7480528ed (diff)
downloadhaskell-29be1a8afa6aece04ca85060662510a14d2ff8b0.tar.gz
Discard dead assignments in tryToInline
Inlining global registers and constants made code slightly larger in some cases. I finally got around to looking into why, and discovered one reason: we weren't discarding dead code in some cases. This patch fixes it.
Diffstat (limited to 'compiler/cmm/CmmSink.hs')
-rw-r--r--compiler/cmm/CmmSink.hs30
1 files changed, 26 insertions, 4 deletions
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 17b72c0f99..6a3bcb7840 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -295,8 +295,8 @@ walk :: DynFlags
-> Assignments -- The current list of
-- assignments we are sinking.
- -- Later assignments may refer
- -- to earlier ones.
+ -- Earlier assignments may refer
+ -- to later ones.
-> ( Block CmmNode O O -- The new block
, Assignments -- Assignments to sink further
@@ -405,6 +405,7 @@ tryToInline dflags live node assigs = go usages node [] assigs
go usages node skipped (a@(l,rhs,_) : rest)
| cannot_inline = dont_inline
+ | occurs_none = discard -- Note [discard during inlining]
| occurs_once = inline_and_discard
| isTrivial rhs = inline_and_keep
| otherwise = dont_inline
@@ -412,6 +413,8 @@ tryToInline dflags live node assigs = go usages node [] assigs
inline_and_discard = go usages' inl_node skipped rest
where usages' = foldLocalRegsUsed dflags addUsage usages rhs
+ discard = go usages node skipped rest
+
dont_inline = keep node -- don't inline the assignment, keep it
inline_and_keep = keep inl_node -- inline the assignment, keep it
@@ -427,8 +430,11 @@ tryToInline dflags live node assigs = go usages node [] assigs
|| l `elem` skipped
|| not (okToInline dflags rhs node)
- occurs_once = not (l `elemRegSet` live)
- && lookupUFM usages l == Just 1
+ l_usages = lookupUFM usages l
+ l_live = l `elemRegSet` live
+
+ occurs_once = not l_live && l_usages == Just 1
+ occurs_none = not l_live && l_usages == Nothing
inl_node = mapExpDeep inline node
-- mapExpDeep is where the inlining actually takes place!
@@ -468,6 +474,22 @@ tryToInline dflags live node assigs = go usages node [] assigs
-- trivial rhs's). But of course we can't, because y is equal to e,
-- not z.
+-- Note [discard during inlining]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Opportunities to discard assignments sometimes appear after we've
+-- done some inlining. Here's an example:
+--
+-- x = R1;
+-- y = P64[x + 7];
+-- z = P64[x + 15];
+-- /* z is dead */
+-- R1 = y & (-8);
+--
+-- The x assignment is trivial, so we inline it in the RHS of y, and
+-- keep both x and y. z gets dropped because it is dead, then we
+-- inline y, and we have a dead assignment to x. If we don't notice
+-- that x is dead in tryToInline, we end up retaining it.
+
addUsage :: UniqFM Int -> LocalReg -> UniqFM Int
addUsage m r = addToUFM_C (+) m r 1