X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FGraphColor.hs;h=8dc41216e7996e194fc45ad4df7d2d3ce3f0ef28;hp=307803a988109660ca35c224bb2f1b1c7e4436c5;hb=f537dd87c4a07526e2b1fc1bd1c125d652833641;hpb=b01110d1352de5d972d8fb63f28c244d2c1ff99b diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 307803a..8dc4121 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -1,9 +1,9 @@ +{-# OPTIONS -fno-warn-missing-signatures #-} -- | Graph Coloring. -- This is a generic graph coloring library, abstracted over the type of -- the node keys, nodes and colors. -- -{-# OPTIONS -fno-warn-missing-signatures #-} module GraphColor ( module GraphBase, @@ -39,6 +39,7 @@ colorGraph , Eq color, Eq cls, Ord k , Outputable k, Outputable cls, Outputable color) => Bool -- ^ whether to do iterative coalescing + -> Int -- ^ how many times we've tried to color this graph so far. -> UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class). -> Triv k cls color -- ^ fn to decide whether a node is trivially colorable. -> (Graph k cls color -> k) -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable. @@ -49,15 +50,22 @@ colorGraph , UniqFM k ) -- map of regs (r1 -> r2) that were coaleced -- r1 should be replaced by r2 in the source -colorGraph iterative colors triv spill graph0 +colorGraph iterative spinCount colors triv spill graph0 = let - -- if we're not doing iterative coalescing, then just do a single coalescing - -- pass at the front. This won't be as good but should still eat up a - -- lot of the reg-reg moves. + -- If we're not doing iterative coalescing then do an aggressive coalescing first time + -- around and then conservative coalescing for subsequent passes. + -- + -- Aggressive coalescing is a quick way to get rid of many reg-reg moves. However, if + -- there is a lot of register pressure and we do it on every round then it can make the + -- graph less colorable and prevent the algorithm from converging in a sensible number + -- of cycles. + -- (graph_coalesced, kksCoalesce1) - = if not iterative - then coalesceGraph False triv graph0 - else (graph0, []) + = if iterative + then (graph0, []) + else if spinCount == 0 + then coalesceGraph True triv graph0 + else coalesceGraph False triv graph0 -- run the scanner to slurp out all the trivially colorable nodes -- (and do coalescing if iterative coalescing is enabled) @@ -90,12 +98,13 @@ colorGraph iterative colors triv spill graph0 -- with the provided triv function. -- in if not $ null ksNoTriv - then pprPanic "colorGraph: trivially colorable nodes didn't color!" empty -{- ( empty + then pprPanic "colorGraph: trivially colorable nodes didn't color!" -- empty + ( empty $$ text "ksTriv = " <> ppr ksTriv $$ text "ksNoTriv = " <> ppr ksNoTriv + $$ text "colors = " <> ppr colors $$ empty - $$ dotGraph (\x -> text "white") triv graph1) -} + $$ dotGraph (\_ -> text "white") triv graph_triv) else ( graph_prob , mkUniqSet ksNoColor -- the nodes that didn't color (spills) @@ -123,7 +132,7 @@ colorGraph iterative colors triv spill graph0 colorScan :: ( Uniquable k, Uniquable cls, Uniquable color , Ord k, Eq cls - , Outputable k, Outputable color) + , Outputable k, Outputable cls) => Bool -- ^ whether to do iterative coalescing -> Triv k cls color -- ^ fn to decide whether a node is trivially colorable -> (Graph k cls color -> k) -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable. @@ -139,7 +148,7 @@ colorScan_spin iterative triv spill graph -- if the graph is empty then we're done | isNullUFM $ graphMap graph - = (ksTriv, ksSpill, kksCoalesce) + = (ksTriv, ksSpill, reverse kksCoalesce) -- Simplify: -- Look for trivially colorable nodes. @@ -154,26 +163,26 @@ colorScan_spin iterative triv spill graph $ graph , ksTrivFound <- map nodeId nsTrivFound - , graph3 <- foldr (\k g -> let Just g' = delNode k g + , graph2 <- foldr (\k g -> let Just g' = delNode k g in g') graph ksTrivFound - = colorScan_spin iterative triv spill graph3 + = colorScan_spin iterative triv spill graph2 (ksTrivFound ++ ksTriv) ksSpill kksCoalesce -- Coalesce: -- If we're doing iterative coalescing and no triv nodes are avaliable - -- then it's type for a coalescing pass. + -- then it's time for a coalescing pass. | iterative = case coalesceGraph False triv graph of -- we were able to coalesce something - -- go back and see if this frees up more nodes to be trivially colorable. + -- go back to Simplify and see if this frees up more nodes to be trivially colorable. (graph2, kksCoalesceFound @(_:_)) -> colorScan_spin iterative triv spill graph2 - ksTriv ksSpill (kksCoalesceFound ++ kksCoalesce) + ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce) -- Freeze: -- nothing could be coalesced (or was triv), @@ -216,7 +225,8 @@ colorScan_spill iterative triv spill graph -- | Try to assign a color to all these nodes. assignColors - :: ( Uniquable k, Uniquable cls, Uniquable color, Eq color ) + :: ( Uniquable k, Uniquable cls, Uniquable color + , Eq color, Outputable cls) => UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class). -> Graph k cls color -- ^ the graph -> [k] -- ^ nodes to assign a color to. @@ -253,7 +263,8 @@ assignColors colors graph ks -- returns Nothing if no color can be assigned to this node. -- selectColor - :: ( Uniquable k, Uniquable cls, Uniquable color, Eq color) + :: ( Uniquable k, Uniquable cls, Uniquable color + , Eq color, Outputable cls) => UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class). -> Graph k cls color -- ^ the graph -> k -- ^ key of the node to select a color for. @@ -264,8 +275,10 @@ selectColor colors graph u Just node = lookupNode graph u -- lookup the available colors for the class of this node. - Just colors_avail - = lookupUFM colors (nodeClass node) + colors_avail + = case lookupUFM colors (nodeClass node) of + Nothing -> pprPanic "selectColor: no colors available for class " (ppr (nodeClass node)) + Just cs -> cs -- find colors we can't use because they're already being used -- by a node that conflicts with this one.