Fix CodingStyle#Warnings URLs

[ghc-hetmet.git] / compiler / nativeGen / RegAllocColor.hs

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 27b603c..b9eda1b 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -13,11 +13,11 @@
 --     Colors in graphviz graphs could be nicer.
 --
 
-{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module RegAllocColor ( 
@@ -34,7 +34,6 @@ import RegSpillClean
 import RegAllocStats
 import MachRegs
 import MachInstrs
-import RegCoalesce
 import PprMach
 
 import UniqSupply
@@ -107,14 +106,22 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
        let spill       = chooseSpill_maxLife fmLife
        
        -- try and color the graph 
-       let (graph_colored, rsSpill)    
+       let (graph_colored, rsSpill, rmCoalesce)
                        = Color.colorGraph regsFree triv spill graph
 
+       -- rewrite regs in the code that have been coalesced
+       let patchF reg  = case lookupUFM rmCoalesce reg of
+                               Just reg'       -> reg'
+                               Nothing         -> reg
+       let code_coalesced
+                       = map (patchEraseLive patchF) code
+
+
        -- see if we've found a coloring
        if isEmptyUniqSet rsSpill
         then do
                -- patch the registers using the info in the graph
-               let code_patched        = map (patchRegsFromGraph graph_colored) code
+               let code_patched        = map (patchRegsFromGraph graph_colored) code_coalesced
 
                -- clean out unneeded SPILL/RELOADs
                let code_spillclean     = map cleanSpills code_patched
@@ -130,6 +137,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
                let stat                =
                        RegAllocStatsColored
                        { raGraph       = graph_colored
+                       , raCoalesced   = rmCoalesce
                        , raPatched     = code_patched
                        , raSpillClean  = code_spillclean
                        , raFinal       = code_final
@@ -144,7 +152,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
         else do
                -- spill the uncolored regs
                (code_spilled, slotsFree', spillStats)
-                       <- regSpill code slotsFree rsSpill
+                       <- regSpill code_coalesced slotsFree rsSpill
                        
                -- recalculate liveness
                let code_nat    = map stripLive code_spilled
@@ -154,6 +162,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
                let stat        =
                        RegAllocStatsSpill
                        { raGraph       = graph_colored
+                       , raCoalesced   = rmCoalesce
                        , raSpillStats  = spillStats
                        , raLifetimes   = fmLife
                        , raSpilled     = code_spilled }
@@ -214,16 +223,20 @@ buildGraph
        
 buildGraph code
  = do
-       -- Add the reg-reg conflicts to the graph
-       let conflictSets        = unionManyBags (map slurpConflicts code)
-       let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictSets
+       -- Slurp out the conflicts and reg->reg moves from this code
+       let (conflictList, moveList) =
+               unzip $ map slurpConflicts code
 
+       let conflictBag         = unionManyBags conflictList
+       let moveBag             = unionManyBags moveList
+
+       -- Add the reg-reg conflicts to the graph
+       let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictBag
 
        -- Add the coalescences edges to the graph.
-       let coalesce            = unionManyBags (map slurpJoinMovs code)
-       let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict coalesce
+       let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict moveBag
                        
-       return  $ graph_coalesce
+       return  graph_coalesce
 
 
 -- | Add some conflict edges to the graph.