Merge in new code generator branch.

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Graph / Stats.hs

diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index 10ab0cb..5ff7bff 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -1,8 +1,6 @@
 {-# OPTIONS -fno-warn-missing-signatures #-}
--- Carries interesting info for debugging / profiling of the 
+-- | Carries interesting info for debugging / profiling of the 
 --     graph coloring register allocator.
---
-
 module RegAlloc.Graph.Stats (
        RegAllocStats (..),
 
@@ -23,11 +21,14 @@ import qualified GraphColor as Color
 import RegAlloc.Liveness
 import RegAlloc.Graph.Spill
 import RegAlloc.Graph.SpillCost
+import RegAlloc.Graph.TrivColorable
 import Instruction
 import RegClass
 import Reg
+import TargetReg
 
-import Cmm
+import OldCmm
+import OldPprCmm()
 import Outputable
 import UniqFM
 import UniqSet
@@ -45,7 +46,8 @@ data RegAllocStats instr
 
        -- a spill stage
        | RegAllocStatsSpill
-       { raGraph       :: Color.Graph VirtualReg RegClass RealReg      -- ^ the partially colored graph
+       { raCode        :: [LiveCmmTop instr]                           -- ^ the code we tried to allocate registers for
+       , raGraph       :: Color.Graph VirtualReg RegClass RealReg      -- ^ the partially colored graph
        , raCoalesced   :: UniqFM VirtualReg                            -- ^ the regs that were coaleced
        , raSpillStats  :: SpillStats                                   -- ^ spiller stats
        , raSpillCosts  :: SpillCostInfo                                -- ^ number of instrs each reg lives for
@@ -53,13 +55,15 @@ data RegAllocStats instr
 
        -- a successful coloring
        | RegAllocStatsColored
-       { raGraph        :: Color.Graph VirtualReg RegClass RealReg     -- ^ the uncolored graph
-       , raGraphColored :: Color.Graph VirtualReg RegClass RealReg     -- ^ the coalesced and colored graph
-       , raCoalesced   :: UniqFM VirtualReg                            -- ^ the regs that were coaleced
-       , raPatched     :: [LiveCmmTop instr]                           -- ^ code with vregs replaced by hregs
-       , raSpillClean  :: [LiveCmmTop instr]                           -- ^ code with unneeded spill\/reloads cleaned out
-       , raFinal       :: [NatCmmTop instr]                            -- ^ final code
-       , raSRMs        :: (Int, Int, Int) }                            -- ^ spill\/reload\/reg-reg moves present in this code
+       { raCode          :: [LiveCmmTop instr]                         -- ^ the code we tried to allocate registers for
+       , raGraph         :: Color.Graph VirtualReg RegClass RealReg    -- ^ the uncolored graph
+       , raGraphColored  :: Color.Graph VirtualReg RegClass RealReg    -- ^ the coalesced and colored graph
+       , raCoalesced     :: UniqFM VirtualReg                          -- ^ the regs that were coaleced
+       , raCodeCoalesced :: [LiveCmmTop instr]                         -- ^ code with coalescings applied 
+       , raPatched       :: [LiveCmmTop instr]                         -- ^ code with vregs replaced by hregs
+       , raSpillClean    :: [LiveCmmTop instr]                         -- ^ code with unneeded spill\/reloads cleaned out
+       , raFinal         :: [NatCmmTop instr]                          -- ^ final code
+       , raSRMs          :: (Int, Int, Int) }                          -- ^ spill\/reload\/reg-reg moves present in this code
 
 instance Outputable instr => Outputable (RegAllocStats instr) where
 
@@ -68,16 +72,21 @@ instance Outputable instr => Outputable (RegAllocStats instr) where
        $$ text "#  Native code with liveness information."
        $$ ppr (raLiveCmm s)
        $$ text ""
---     $$ text "#  Initial register conflict graph."
---     $$ Color.dotGraph regDotColor trivColorable (raGraph s)
+       $$ text "#  Initial register conflict graph."
+       $$ Color.dotGraph 
+               targetRegDotColor
+               (trivColorable 
+                       targetVirtualRegSqueeze
+                       targetRealRegSqueeze)
+               (raGraph s)
 
 
  ppr (s@RegAllocStatsSpill{})
        =  text "#  Spill"
 
---     $$ text "#  Register conflict graph."
---     $$ Color.dotGraph regDotColor trivColorable (raGraph s)
---     $$ text ""
+       $$ text "#  Code with liveness information."
+       $$ (ppr (raCode s))
+       $$ text ""
 
        $$ (if (not $ isNullUFM $ raCoalesced s)
                then    text "#  Registers coalesced."
@@ -85,10 +94,6 @@ instance Outputable instr => Outputable (RegAllocStats instr) where
                        $$ text ""
                else empty)
 
---     $$ text "#  Spill costs.  reg uses defs lifetime degree cost"
---     $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
---     $$ text ""
-
        $$ text "#  Spills inserted."
        $$ ppr (raSpillStats s)
        $$ text ""
@@ -100,13 +105,18 @@ instance Outputable instr => Outputable (RegAllocStats instr) where
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
        =  text "#  Colored"
 
---     $$ text "#  Register conflict graph (initial)."
---     $$ Color.dotGraph regDotColor trivColorable (raGraph s)
---     $$ text ""
+       $$ text "#  Code with liveness information."
+       $$ (ppr (raCode s))
+       $$ text ""
 
---     $$ text "#  Register conflict graph (colored)."
---     $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
---     $$ text ""
+       $$ text "#  Register conflict graph (colored)."
+       $$ Color.dotGraph 
+               targetRegDotColor
+               (trivColorable 
+                       targetVirtualRegSqueeze
+                       targetRealRegSqueeze)
+               (raGraphColored s)
+       $$ text ""
 
        $$ (if (not $ isNullUFM $ raCoalesced s)
                then    text "#  Registers coalesced."
@@ -114,6 +124,10 @@ instance Outputable instr => Outputable (RegAllocStats instr) where
                        $$ text ""
                else empty)
 
+       $$ text "#  Native code after coalescings applied."
+       $$ ppr (raCodeCoalesced s)
+       $$ text ""
+
        $$ text "#  Native code after register allocation."
        $$ ppr (raPatched s)
        $$ text ""
@@ -240,7 +254,6 @@ pprStatsLifeConflict stats graph
 
 -- | Count spill/reload/reg-reg moves.
 --     Lets us see how well the register allocator has done.
---
 countSRMs 
        :: Instruction instr
        => LiveCmmTop instr -> (Int, Int, Int)
@@ -253,15 +266,15 @@ countSRM_block (BasicBlock i instrs)
        return  $ BasicBlock i instrs'
 
 countSRM_instr li
-       | SPILL _ _     <- li
-       = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
+       | LiveInstr SPILL{} _    <- li
+       = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
                return li
 
-       | RELOAD _ _    <- li
-       = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
+       | LiveInstr RELOAD{} _  <- li
+       = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
                return li
-
-       | Instr instr _ <- li
+       
+       | LiveInstr instr _     <- li
        , Just _        <- takeRegRegMoveInstr instr
        = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
                return li
@@ -273,18 +286,3 @@ countSRM_instr li
 addSRM (s1, r1, m1) (s2, r2, m2)
        = (s1+s2, r1+r2, m1+m2)
 
-
-
-
-
-
-{-
-toX11Color (r, g, b)
- = let rs      = padL 2 '0' (showHex r "")
-       gs      = padL 2 '0' (showHex r "")
-       bs      = padL 2 '0' (showHex r "")
-
-       padL n c s
-               = replicate (n - length s) c ++ s
-  in   "#" ++ rs ++ gs ++ bs
--}