change of representation for GenCmm, GenCmmTop, CmmProc

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

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 5a3401f..2e3d40e 100644 (file)
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -12,6 +12,7 @@
 --
 --     Colors in graphviz graphs could be nicer.
 --
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocColor ( 
        regAlloc,
@@ -27,7 +28,6 @@ import RegSpillClean
 import RegAllocStats
 import MachRegs
 import MachInstrs
-import RegCoalesce
 import PprMach
 
 import UniqSupply
@@ -61,7 +61,7 @@ regAlloc
                
 regAlloc dump regsFree slotsFree code
  = do
-       (code_final, debug_codeGraphs, graph_final)
+       (code_final, debug_codeGraphs, _)
                <- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
        
        return  ( code_final
@@ -83,7 +83,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 
        -- build a map of how many instructions each reg lives for.
        --      this is lazy, it won't be computed unless we need to spill
-       let fmLife      = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
+       let fmLife      = plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
                        $ map lifetimeCount code
 
        -- record startup state
@@ -100,14 +100,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
@@ -123,9 +131,11 @@ 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 }
+                       , raFinal       = code_final
+                       , raSRMs        = foldl addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 
                return  ( code_final
                        , if dump
@@ -136,7 +146,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
@@ -146,6 +156,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 }
@@ -206,16 +217,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.
@@ -249,10 +264,10 @@ graphAddCoalesce
        -> Color.Graph Reg RegClass Reg
        
 graphAddCoalesce (r1, r2) graph
-       | RealReg regno <- r1
+       | RealReg _ <- r1
        = Color.addPreference (regWithClass r2) r1 graph
        
-       | RealReg regno <- r2
+       | RealReg _ <- r2
        = Color.addPreference (regWithClass r1) r2 graph
        
        | otherwise
@@ -285,7 +300,7 @@ patchRegsFromGraph graph code
                = pprPanic "patchRegsFromGraph: register mapping failed." 
                        (  text "There is no node in the graph for register " <> ppr reg
                        $$ ppr code
-                       $$ Color.dotGraph (\x -> text "white") trivColorable graph)
+                       $$ Color.dotGraph (\_ -> text "white") trivColorable graph)
        
    in  patchEraseLive patchF code