X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FStats.hs;h=5ff7bff91a67507683b03559cdf1806be7e5afb9;hp=8082f9e97533fc85eb19e1674377a71e04e49e09;hb=f8f0e76ad302fda30196ebc9230e5fcbc97be537;hpb=ee6bba6f3d80c56b47bc623bc6e4f076be1f046f diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index 8082f9e..5ff7bff 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -1,11 +1,8 @@ {-# 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 (..), - regDotColor, pprStats, pprStatsSpills, @@ -22,13 +19,16 @@ where import qualified GraphColor as Color import RegAlloc.Liveness -import RegAllocInfo import RegAlloc.Graph.Spill import RegAlloc.Graph.SpillCost -import Regs -import Instrs -import Cmm - +import RegAlloc.Graph.TrivColorable +import Instruction +import RegClass +import Reg +import TargetReg + +import OldCmm +import OldPprCmm() import Outputable import UniqFM import UniqSet @@ -36,33 +36,36 @@ import State import Data.List -data RegAllocStats +data RegAllocStats instr -- initial graph = RegAllocStatsStart - { raLiveCmm :: [LiveCmmTop] -- ^ initial code, with liveness - , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph - , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill + { raLiveCmm :: [LiveCmmTop instr] -- ^ initial code, with liveness + , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the initial, uncolored graph + , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill -- 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 - , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for - , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added + { 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 + , raSpilled :: [LiveCmmTop instr] } -- ^ code with spill instructions added -- a successful coloring | RegAllocStatsColored - { 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 - , raFinal :: [NatCmmTop] -- ^ final code - , raSRMs :: (Int, Int, Int) } -- ^ spill\/reload\/reg-reg moves present in this code - -instance Outputable RegAllocStats where + { 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 ppr (s@RegAllocStatsStart{}) = text "# Start" @@ -70,14 +73,19 @@ instance Outputable RegAllocStats where $$ ppr (raLiveCmm s) $$ text "" $$ text "# Initial register conflict graph." - $$ Color.dotGraph regDotColor trivColorable (raGraph s) + $$ Color.dotGraph + targetRegDotColor + (trivColorable + targetVirtualRegSqueeze + targetRealRegSqueeze) + (raGraph s) ppr (s@RegAllocStatsSpill{}) = text "# Spill" - $$ text "# Register conflict graph." - $$ Color.dotGraph regDotColor trivColorable (raGraph s) + $$ text "# Code with liveness information." + $$ (ppr (raCode s)) $$ text "" $$ (if (not $ isNullUFM $ raCoalesced s) @@ -86,10 +94,6 @@ instance Outputable RegAllocStats 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 "" @@ -101,12 +105,17 @@ instance Outputable RegAllocStats where ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) = text "# Colored" - $$ text "# Register conflict graph (initial)." - $$ Color.dotGraph regDotColor trivColorable (raGraph s) + $$ text "# Code with liveness information." + $$ (ppr (raCode s)) $$ text "" $$ text "# Register conflict graph (colored)." - $$ Color.dotGraph regDotColor trivColorable (raGraphColored s) + $$ Color.dotGraph + targetRegDotColor + (trivColorable + targetVirtualRegSqueeze + targetRealRegSqueeze) + (raGraphColored s) $$ text "" $$ (if (not $ isNullUFM $ raCoalesced s) @@ -115,6 +124,10 @@ instance Outputable RegAllocStats where $$ text "" else empty) + $$ text "# Native code after coalescings applied." + $$ ppr (raCodeCoalesced s) + $$ text "" + $$ text "# Native code after register allocation." $$ ppr (raPatched s) $$ text "" @@ -133,7 +146,11 @@ instance Outputable RegAllocStats where $$ text "" -- | Do all the different analysis on this list of RegAllocStats -pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc +pprStats + :: [RegAllocStats instr] + -> Color.Graph VirtualReg RegClass RealReg + -> SDoc + pprStats stats graph = let outSpills = pprStatsSpills stats outLife = pprStatsLifetimes stats @@ -145,7 +162,7 @@ pprStats stats graph -- | Dump a table of how many spill loads \/ stores were inserted for each vreg. pprStatsSpills - :: [RegAllocStats] -> SDoc + :: [RegAllocStats instr] -> SDoc pprStatsSpills stats = let @@ -163,7 +180,7 @@ pprStatsSpills stats -- | Dump a table of how long vregs tend to live for in the initial code. pprStatsLifetimes - :: [RegAllocStats] -> SDoc + :: [RegAllocStats instr] -> SDoc pprStatsLifetimes stats = let info = foldl' plusSpillCostInfo zeroSpillCostInfo @@ -177,7 +194,7 @@ pprStatsLifetimes stats $$ (vcat $ map ppr $ eltsUFM lifeBins) $$ text "\n") -binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int) +binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int) binLifetimeCount fm = let lifes = map (\l -> (l, (l, 1))) $ map snd @@ -191,7 +208,7 @@ binLifetimeCount fm -- | Dump a table of how many conflicts vregs tend to have in the initial code. pprStatsConflict - :: [RegAllocStats] -> SDoc + :: [RegAllocStats instr] -> SDoc pprStatsConflict stats = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2))) @@ -208,8 +225,8 @@ pprStatsConflict stats -- | For every vreg, dump it's how many conflicts it has and its lifetime -- good for making a scatter plot. pprStatsLifeConflict - :: [RegAllocStats] - -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph + :: [RegAllocStats instr] + -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph -> SDoc pprStatsLifeConflict stats graph @@ -237,8 +254,10 @@ pprStatsLifeConflict stats graph -- | Count spill/reload/reg-reg moves. -- Lets us see how well the register allocator has done. --- -countSRMs :: LiveCmmTop -> (Int, Int, Int) +countSRMs + :: Instruction instr + => LiveCmmTop instr -> (Int, Int, Int) + countSRMs cmm = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0) @@ -246,16 +265,17 @@ countSRM_block (BasicBlock i instrs) = do instrs' <- mapM countSRM_instr instrs return $ BasicBlock i instrs' -countSRM_instr li@(Instr instr _) - | SPILL _ _ <- instr - = do modify $ \(s, r, m) -> (s + 1, r, m) +countSRM_instr li + | LiveInstr SPILL{} _ <- li + = do modify $ \(s, r, m) -> (s + 1, r, m) return li - | RELOAD _ _ <- instr - = do modify $ \(s, r, m) -> (s, r + 1, m) + | LiveInstr RELOAD{} _ <- li + = do modify $ \(s, r, m) -> (s, r + 1, m) return li - - | Just _ <- isRegRegMove instr + + | LiveInstr instr _ <- li + , Just _ <- takeRegRegMoveInstr instr = do modify $ \(s, r, m) -> (s, r, m + 1) return li @@ -266,86 +286,3 @@ countSRM_instr li@(Instr instr _) addSRM (s1, r1, m1) (s2, r2, m2) = (s1+s2, r1+r2, m1+m2) ------ --- Register colors for drawing conflict graphs --- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator. - - --- reg colors for x86 -#if i386_TARGET_ARCH -regDotColor :: Reg -> SDoc -regDotColor reg - = let Just str = lookupUFM regColors reg - in text str - -regColors - = listToUFM - $ [ (eax, "#00ff00") - , (ebx, "#0000ff") - , (ecx, "#00ffff") - , (edx, "#0080ff") - - , (fake0, "#ff00ff") - , (fake1, "#ff00aa") - , (fake2, "#aa00ff") - , (fake3, "#aa00aa") - , (fake4, "#ff0055") - , (fake5, "#5500ff") ] - - --- reg colors for x86_64 -#elif x86_64_TARGET_ARCH -regDotColor :: Reg -> SDoc -regDotColor reg - = let Just str = lookupUFM regColors reg - in text str - -regColors - = listToUFM - $ [ (rax, "#00ff00"), (eax, "#00ff00") - , (rbx, "#0000ff"), (ebx, "#0000ff") - , (rcx, "#00ffff"), (ecx, "#00ffff") - , (rdx, "#0080ff"), (edx, "#00ffff") - , (r8, "#00ff80") - , (r9, "#008080") - , (r10, "#0040ff") - , (r11, "#00ff40") - , (r12, "#008040") - , (r13, "#004080") - , (r14, "#004040") - , (r15, "#002080") ] - - ++ zip (map RealReg [16..31]) (repeat "red") - - --- reg colors for ppc -#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 - - -{- -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 --}