Show spill/reload pseudo instrs in regalloc stage dump

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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 015453e..a762f83 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,8 @@ data RegAllocStats
        -- a successful coloring
        | RegAllocStatsColored
        { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
-       , raPatchedCmm  :: [LiveCmmTop] }               -- ^ code after register allocation
-
+       , raPatchedCmm  :: [LiveCmmTop]                 -- ^ code after register allocation 
+       , raFinalCmm    :: [NatCmmTop] }                -- ^ final code
 
 instance Outputable RegAllocStats where
 
@@ -77,6 +78,10 @@ instance Outputable RegAllocStats where
        $$ text ""
        $$ text "#  Native code after register allocation."
        $$ ppr (raPatchedCmm s)
+       $$ text ""
+       $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
+       $$ ppr (raFinalCmm s)
+       $$ text ""
 
 
 -- | Do all the different analysis on this list of RegAllocStats
@@ -176,8 +181,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)