Erase unneeded spill/reloads after register allocation

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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 015453e..7e08c1c 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -21,6 +21,7 @@ import qualified GraphColor as Color
 import RegLiveness
 import RegSpill
 import MachRegs
+import MachInstrs
 
 import Outputable
 import UniqFM
@@ -46,8 +47,9 @@ data RegAllocStats
        -- a successful coloring
        | RegAllocStatsColored
        { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
-       , raPatchedCmm  :: [LiveCmmTop] }               -- ^ code after register allocation
-
+       , raPatched     :: [LiveCmmTop]                 -- ^ code with vregs replaced by hregs
+       , raSpillClean  :: [LiveCmmTop]                 -- ^ code with unneeded spill/reloads cleaned out
+       , raFinal       :: [NatCmmTop] }                -- ^ final code
 
 instance Outputable RegAllocStats where
 
@@ -76,7 +78,14 @@ instance Outputable RegAllocStats where
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
        $$ text ""
        $$ text "#  Native code after register allocation."
-       $$ ppr (raPatchedCmm s)
+       $$ ppr (raPatched s)
+       $$ text ""
+       $$ text "#  Clean out unneeded spill/reloads."
+       $$ ppr (raSpillClean s)
+       $$ text ""
+       $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
+       $$ ppr (raFinal s)
+       $$ text ""
 
 
 -- | Do all the different analysis on this list of RegAllocStats
@@ -176,8 +185,10 @@ pprStatsLifeConflict stats graph
  = let lifeMap = foldl' plusUFM emptyUFM
                        [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
 
-       scatter = map   (\r ->  let Just (_, lifetime)  = lookupUFM lifeMap r
-                                   Just node           = Color.lookupNode graph r
+       scatter = map   (\r ->  let lifetime    = case lookupUFM lifeMap r of
+                                                       Just (_, l)     -> l
+                                                       Nothing         -> 0
+                                   Just node   = Color.lookupNode graph r
                                in parens $ hcat $ punctuate (text ", ")
                                        [ doubleQuotes $ ppr $ Color.nodeId node
                                        , ppr $ sizeUniqSet (Color.nodeConflicts node)