SPARC NCG: fill branch delay slot after tabled jump (doh!)

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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 81578a3..12f4cee 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -1,7 +1,7 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -- Carries interesting info for debugging / profiling of the 
 --     graph coloring register allocator.
 --
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocStats (
        RegAllocStats (..),
@@ -54,12 +54,13 @@ data RegAllocStats
 
        -- a successful coloring
        | RegAllocStatsColored
-       { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
+       { raGraph        :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
+       , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and 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
+       , raSpillClean  :: [LiveCmmTop]                 -- ^ code with unneeded spill\/reloads cleaned out
        , raFinal       :: [NatCmmTop]                  -- ^ final code
-       , raSRMs        :: (Int, Int, Int) }            -- ^ spill/reload/reg-reg moves present in this code
+       , raSRMs        :: (Int, Int, Int) }            -- ^ spill\/reload\/reg-reg moves present in this code
 
 instance Outputable RegAllocStats where
 
@@ -100,10 +101,14 @@ instance Outputable RegAllocStats where
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
        =  text "#  Colored"
 
-       $$ text "#  Register conflict graph."
+       $$ text "#  Register conflict graph (initial)."
        $$ Color.dotGraph regDotColor trivColorable (raGraph s)
        $$ text ""
 
+       $$ text "#  Register conflict graph (colored)."
+       $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
+       $$ text ""
+
        $$ (if (not $ isNullUFM $ raCoalesced s)
                then    text "#  Registers coalesced."
                        $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
@@ -138,7 +143,7 @@ pprStats stats graph
   in   vcat [outSpills, outLife, outConflict, outScatter]
 
 
--- | Dump a table of how many spill loads / stores were inserted for each vreg.
+-- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
 pprStatsSpills
        :: [RegAllocStats] -> SDoc
 
@@ -146,7 +151,7 @@ pprStatsSpills stats
  = let
        finals  = [ s   | s@RegAllocStatsColored{} <- stats]
 
-       -- sum up how many stores/loads/reg-reg-moves were left in the code
+       -- sum up how many stores\/loads\/reg-reg-moves were left in the code
        total   = foldl' addSRM (0, 0, 0)
                $ map raSRMs finals
 
@@ -286,11 +291,10 @@ regColors
        , (fake3, "#aa00aa")
        , (fake4, "#ff0055")
        , (fake5, "#5500ff") ]
-#endif
 
 
 -- reg colors for x86_64
-#if x86_64_TARGET_ARCH
+#elif x86_64_TARGET_ARCH
 regDotColor :: Reg -> SDoc
 regDotColor reg
  = let Just    str     = lookupUFM regColors reg
@@ -312,16 +316,26 @@ regColors
        , (r15, "#002080") ]
 
        ++ zip (map RealReg [16..31]) (repeat "red")
-#endif
 
 
 -- reg colors for ppc
-#if powerpc_TARGET_ARCH
+#elif powerpc_TARGET_ARCH
+regDotColor :: Reg -> SDoc
+regDotColor reg
+ = case regClass reg of
+       RcInteger       -> text "blue"
+       RcFloat         -> text "red"
+       RcDouble        -> text "green"
+
+#elif sparc_TARGET_ARCH
 regDotColor :: Reg -> SDoc
 regDotColor reg
  = case regClass reg of
        RcInteger       -> text "blue"
        RcFloat         -> text "red"
+       RcDouble        -> text "green"
+#else
+#error ToDo: regDotColor
 #endif