Refactor MachRegs.trivColorable to do unboxed accumulation

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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index a38db1d..728225a 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -1,6 +1,7 @@
-
 -- Carries interesting info for debugging / profiling of the 
 --     graph coloring register allocator.
+--
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocStats (
        RegAllocStats (..),
@@ -45,6 +46,7 @@ data RegAllocStats
        -- a spill stage
        | RegAllocStatsSpill
        { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
+       , raCoalesced   :: UniqFM Reg                   -- ^ the regs that were coaleced
        , raSpillStats  :: SpillStats                   -- ^ spiller stats
        , raLifetimes   :: UniqFM (Reg, Int)            -- ^ number of instrs each reg lives for
        , raSpilled     :: [LiveCmmTop] }               -- ^ code with spill instructions added
@@ -52,6 +54,7 @@ data RegAllocStats
        -- a successful coloring
        | RegAllocStatsColored
        { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the 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
        , raFinal       :: [NatCmmTop]                  -- ^ final code
@@ -67,28 +70,49 @@ instance Outputable RegAllocStats where
        $$ text "#  Initial register conflict graph."
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
 
+
  ppr (s@RegAllocStatsSpill{})
        =  text "#  Spill"
+
        $$ text "#  Register conflict graph."
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
        $$ text ""
+
+       $$ (if (not $ isNullUFM $ raCoalesced s)
+               then    text "#  Registers coalesced."
+                       $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+                       $$ text ""
+               else empty)
+
        $$ text "#  Spills inserted."
        $$ ppr (raSpillStats s)
        $$ text ""
+
        $$ text "#  Code with spills inserted."
        $$ (ppr (raSpilled s))
 
+
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
        =  text "#  Colored"
+
        $$ text "#  Register conflict graph."
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
        $$ text ""
+
+       $$ (if (not $ isNullUFM $ raCoalesced s)
+               then    text "#  Registers coalesced."
+                       $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+                       $$ text ""
+               else empty)
+
        $$ text "#  Native code after register allocation."
        $$ 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 ""
@@ -148,7 +172,7 @@ binLifetimeCount fm
                $ eltsUFM fm
 
    in  addListToUFM_C
-               (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+               (\(l1, c1) (_, c2) -> (l1, c1 + c2))
                emptyUFM
                lifes
 
@@ -158,7 +182,7 @@ pprStatsConflict
        :: [RegAllocStats] -> SDoc
 
 pprStatsConflict stats
- = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
+ = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
                        emptyUFM
                $ map Color.slurpNodeConflictCount
                        [ raGraph s | s@RegAllocStatsStart{} <- stats ]
@@ -209,12 +233,12 @@ countSRM_block (BasicBlock i instrs)
  = do  instrs' <- mapM countSRM_instr instrs
        return  $ BasicBlock i instrs'
 
-countSRM_instr li@(Instr instr live)
-       | SPILL reg slot        <- instr
+countSRM_instr li@(Instr instr _)
+       | SPILL _ _     <- instr
        = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
                return li
 
-       | RELOAD slot reg       <- instr
+       | RELOAD _ _    <- instr
        = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
                return li