Commit e577a523 authored by Simon Marlow's avatar Simon Marlow

Fix discarding of unreachable code in the register allocator (#9155)

A previous fix to this was wrong: f5879acd
and left some unreachable code behind.  So rather than try to be clever and
do this at the same time as the strongly-connected-component analysis, I'm
doing a separate reachability pass first.
parent b0215729
......@@ -671,14 +671,20 @@ sccBlocks
sccBlocks blocks entries = map (fmap get_node) sccs
where
sccs = stronglyConnCompFromG graph roots
graph = graphFromEdgedVertices nodes
-- nodes :: [(NatBasicBlock instr, Unique, [Unique])]
nodes = [ (block, id, getOutEdges instrs)
| block@(BasicBlock id instrs) <- blocks ]
g1 = graphFromEdgedVertices nodes
reachable :: BlockSet
reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ]
g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes
, id `setMember` reachable ]
sccs = stronglyConnCompG g2
get_node (n, _, _) = n
getOutEdges :: Instruction instr => [instr] -> [BlockId]
......
......@@ -15,10 +15,10 @@ module Digraph(
Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices,
SCC(..), Node, flattenSCC, flattenSCCs,
stronglyConnCompG, stronglyConnCompFromG,
stronglyConnCompG,
topologicalSortG, dfsTopSortG,
verticesG, edgesG, hasVertexG,
reachableG, transposeG,
reachableG, reachablesG, transposeG,
outdegreeG, indegreeG,
vertexGroupsG, emptyG,
componentsG,
......@@ -258,14 +258,6 @@ stronglyConnCompG :: Graph node -> [SCC node]
stronglyConnCompG graph = decodeSccs graph forest
where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph)
-- Find the set of strongly connected components starting from the
-- given roots. This is a good way to discard unreachable nodes at
-- the same time as computing SCCs.
stronglyConnCompFromG :: Graph node -> [node] -> [SCC node]
stronglyConnCompFromG graph roots = decodeSccs graph forest
where forest = {-# SCC "Digraph.scc" #-} sccFrom (gr_int_graph graph) vs
vs = [ v | Just v <- map (gr_node_to_vertex graph) roots ]
decodeSccs :: Graph node -> Forest Vertex -> [SCC node]
decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest
= map decode forest
......@@ -315,7 +307,13 @@ dfsTopSortG graph =
reachableG :: Graph node -> node -> [node]
reachableG graph from = map (gr_vertex_to_node graph) result
where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) from_vertex
result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex]
reachablesG :: Graph node -> [node] -> [node]
reachablesG graph froms = map (gr_vertex_to_node graph) result
where result = {-# SCC "Digraph.reachable" #-}
reachable (gr_int_graph graph) vs
vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]
hasVertexG :: Graph node -> node -> Bool
hasVertexG graph node = isJust $ gr_node_to_vertex graph node
......@@ -548,9 +546,6 @@ postorderF ts = foldr (.) id $ map postorder ts
postOrd :: IntGraph -> [Vertex]
postOrd g = postorderF (dff g) []
postOrdFrom :: IntGraph -> [Vertex] -> [Vertex]
postOrdFrom g vs = postorderF (dfs g vs) []
topSort :: IntGraph -> [Vertex]
topSort = reverse . postOrd
\end{code}
......@@ -574,9 +569,6 @@ undirected g = buildG (bounds g) (edges g ++ reverseE g)
\begin{code}
scc :: IntGraph -> Forest Vertex
scc g = dfs g (reverse (postOrd (transpose g)))
sccFrom :: IntGraph -> [Vertex] -> Forest Vertex
sccFrom g vs = reverse (dfs (transpose g) (reverse (postOrdFrom g vs)))
\end{code}
------------------------------------------------------------
......@@ -602,11 +594,11 @@ forward g tree pre = mapT select g
------------------------------------------------------------
\begin{code}
reachable :: IntGraph -> Vertex -> [Vertex]
reachable g v = preorderF (dfs g [v])
reachable :: IntGraph -> [Vertex] -> [Vertex]
reachable g vs = preorderF (dfs g vs)
path :: IntGraph -> Vertex -> Vertex -> Bool
path g v w = w `elem` (reachable g v)
path g v w = w `elem` (reachable g [v])
\end{code}
------------------------------------------------------------
......
{-# LANGUAGE ScopedTypeVariables #-}
module M () where
import Data.Bits ((.&.))
bitsSet :: Int -> Int -> Bool
bitsSet mask i
= (i .&. mask == mask)
class Eq b => BitMask b where
assocBitMask :: [(b,Int)]
fromBitMask :: Int -> b
fromBitMask i
= walk assocBitMask
where
walk [] = error "Graphics.UI.WX.Types.fromBitMask: empty list"
walk [(x,0)] = x
walk ((x,m):xs) | bitsSet m i = x
| otherwise = walk xs
data Align = AlignLeft
| AlignCentre
deriving Eq
instance BitMask Align where
assocBitMask
= [(AlignCentre,512)
,(AlignLeft, 256)
]
......@@ -22,3 +22,4 @@ test('massive_array',
test('T7237', normal, compile, [''])
test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, [''])
test('T8205', normal, compile, ['-O0'])
test('T9155', normal, compile, ['-O2'])
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