Bugfix to iterative coalescer

Coalescences must be applied to the unsimplified graph in the same order
they were found by the iterative coalescing algorithm - otherwise
the vreg rewrite mapping will be wrong and badness will ensue.

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 0145cf7..40dd64c 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -163,12 +163,13 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
                -- record what happened in this stage for debugging
                let stat                =
                        RegAllocStatsColored
-                       { raGraph       = graph_colored_lint
-                       , raCoalesced   = rmCoalesce
-                       , raPatched     = code_patched
-                       , raSpillClean  = code_spillclean
-                       , raFinal       = code_final
-                       , raSRMs        = foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
+                       { raGraph               = graph
+                       , raGraphColored        = graph_colored_lint
+                       , raCoalesced           = rmCoalesce
+                       , raPatched             = code_patched
+                       , raSpillClean          = code_spillclean
+                       , raFinal               = code_final
+                       , raSRMs                = foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 
 
                let statList =

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 81578a3..ca71f9d 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -54,7 +54,8 @@ data RegAllocStats
 
        -- a successful coloring
        | RegAllocStatsColored
-       { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
+       { raGraph        :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
+       , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and colored graph
        , raCoalesced   :: UniqFM Reg                   -- ^ the regs that were coaleced
        , raPatched     :: [LiveCmmTop]                 -- ^ code with vregs replaced by hregs
        , raSpillClean  :: [LiveCmmTop]                 -- ^ code with unneeded spill/reloads cleaned out
@@ -100,10 +101,14 @@ instance Outputable RegAllocStats where
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
        =  text "#  Colored"
 
-       $$ text "#  Register conflict graph."
+       $$ text "#  Register conflict graph (initial)."
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
        $$ text ""
 
+       $$ text "#  Register conflict graph (colored)."
+       $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
+       $$ text ""
+
        $$ (if (not $ isNullUFM $ raCoalesced s)
                then    text "#  Registers coalesced."
                        $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)

diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index 09fc5c2..bd777b7 100644 (file)
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -138,7 +138,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.
@@ -172,7 +172,7 @@ colorScan_spin iterative triv spill graph
                --      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),

diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index ad5e18f..972dd07 100644 (file)
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -273,7 +273,9 @@ coalesceGraph
                                --      less colorable (aggressive coalescing)
        -> Triv k cls color
        -> Graph k cls color
-       -> (Graph k cls color, [(k, k)])
+       -> ( Graph k cls color
+          , [(k, k)])          -- pairs of nodes that were coalesced, in the order that the
+                               --      coalescing was applied.
 
 coalesceGraph aggressive triv graph
        = coalesceGraph' aggressive triv graph []
@@ -301,8 +303,8 @@ coalesceGraph' aggressive triv graph kkPairsAcc
 
        -- keep running until there are no more coalesces can be found
    in  case catMaybes mPairs of
-        []     -> (graph', kkPairsAcc)
-        pairs  -> coalesceGraph' aggressive triv graph' (pairs ++ kkPairsAcc)
+        []     -> (graph', reverse kkPairsAcc)
+        pairs  -> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
 
 
 -- | Coalesce this pair of nodes unconditionally / agressively.