import RegAllocInfo
import NCGMonad
import PositionIndependentCode
-import RegAllocLinear
-import RegAllocStats
import RegLiveness
import RegCoalesce
-import qualified RegSpill as Spill
+import qualified RegAllocLinear as Linear
import qualified RegAllocColor as Color
+import qualified RegAllocStats as Color
import qualified GraphColor as Color
import Cmm
, cdNative :: [NatCmmTop]
, cdLiveness :: [LiveCmmTop]
, cdCoalesce :: Maybe [LiveCmmTop]
- , cdRegAllocStats :: Maybe [RegAllocStats]
+ , cdRegAllocStats :: Maybe [Color.RegAllocStats]
+ , cdRegAllocStatsLinear :: [Linear.RegAllocStats]
, cdColoredGraph :: Maybe (Color.Graph Reg RegClass Reg)
, cdAlloced :: [NatCmmTop] }
-- Unless they're being dumped, intermediate data structures are squashed after
-- every stage to avoid creating space leaks.
--
+-- TODO: passing data via CmmNativeDump/squashing structs has become a horrible mess.
+-- it might be better to forgo trying to keep all the outputs for each
+-- stage together and just thread IO() through cmmNativeGen so we can dump
+-- what we want to after each stage.
+--
cmmNativeGen :: DynFlags -> RawCmmTop -> UniqSM (CmmNativeGenDump, Pretty.Doc, [CLabel])
cmmNativeGen dflags cmm
= do
native
---- allocate registers
- (alloced, ppr_alloced, ppr_coalesce, ppr_regAllocStats, ppr_coloredGraph)
+ ( alloced, ppr_alloced, ppr_coalesce
+ , ppr_regAllocStats, ppr_regAllocStatsLinear, ppr_coloredGraph)
<- (\withLiveness
-> {-# SCC "regAlloc" #-}
do
coalesced
return ( alloced
- , dchoose dflags Opt_D_dump_asm_regalloc alloced []
- , dchoose dflags Opt_D_dump_asm_coalesce (Just coalesced) Nothing
+ , dchoose dflags Opt_D_dump_asm_regalloc
+ alloced []
+ , dchoose dflags Opt_D_dump_asm_coalesce
+ (Just coalesced) Nothing
, dchooses dflags
[ Opt_D_dump_asm_regalloc_stages
, Opt_D_drop_asm_stats]
(Just regAllocStats) Nothing
- , dchoose dflags Opt_D_dump_asm_conflicts Nothing Nothing)
+ , []
+ , dchoose dflags Opt_D_dump_asm_conflicts
+ Nothing Nothing)
else do
-- do linear register allocation
- alloced <- mapUs regAlloc withLiveness
+ (alloced, stats)
+ <- liftM unzip
+ $ mapUs Linear.regAlloc withLiveness
+
return ( alloced
- , dchoose dflags Opt_D_dump_asm_regalloc alloced []
+ , dchoose dflags Opt_D_dump_asm_regalloc
+ alloced []
, Nothing
, Nothing
+ , dchoose dflags Opt_D_drop_asm_stats
+ (catMaybes stats) []
, Nothing ))
withLiveness
, cdLiveness = ppr_withLiveness
, cdCoalesce = ppr_coalesce
, cdRegAllocStats = ppr_regAllocStats
+ , cdRegAllocStatsLinear = ppr_regAllocStatsLinear
, cdColoredGraph = ppr_coloredGraph
, cdAlloced = ppr_alloced }
cmmNativeGenDump :: DynFlags -> Module -> ModLocation -> [CmmNativeGenDump] -> IO ()
cmmNativeGenDump dflags mod modLocation dump
= do
-
dumpIfSet_dyn dflags
Opt_D_dump_opt_cmm "Optimised Cmm"
(pprCmm $ Cmm $ map cdCmmOpt dump)
dumpIfSet_dyn dflags
- Opt_D_dump_asm_native "(asm-native) Native code"
+ Opt_D_dump_asm_native "Native code"
(vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
dumpIfSet_dyn dflags
- Opt_D_dump_asm_liveness "(asm-liveness) Liveness info added"
+ Opt_D_dump_asm_liveness "Liveness annotations added"
(vcat $ map (ppr . cdLiveness) dump)
dumpIfSet_dyn dflags
- Opt_D_dump_asm_coalesce "(asm-coalesce) Register moves coalesced."
- (vcat $ map (ppr . (\(Just c) -> c) . cdCoalesce) dump)
+ Opt_D_dump_asm_coalesce "Reg-Reg moves coalesced"
+ (vcat $ map (fromMaybe empty . liftM ppr . cdCoalesce) dump)
dumpIfSet_dyn dflags
- Opt_D_dump_asm_regalloc "(asm-regalloc) Registers allocated"
+ Opt_D_dump_asm_regalloc "Registers allocated"
(vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdAlloced dump)
-- with the graph coloring allocator, show the result of each build/spill stage
-- for each block in turn.
- mapM_ (\codeGraphs
- -> dumpIfSet_dyn dflags
- Opt_D_dump_asm_regalloc_stages "(asm-regalloc-stages)"
- (vcat $ map (\(stage, stats) ->
- text "-- Stage " <> int stage
- $$ ppr stats)
- (zip [0..] codeGraphs)))
- $ map ((\(Just c) -> c) . cdRegAllocStats) dump
+ when (dopt Opt_D_dump_asm_regalloc_stages dflags)
+ $ do mapM_ (\stats
+ -> printDump
+ $ vcat $ map (\(stage, stats) ->
+ text "-- Stage " <> int stage
+ $$ ppr stats)
+ (zip [0..] stats))
+ $ map (fromMaybe [] . cdRegAllocStats) dump
-- Build a global register conflict graph.
-- If you want to see the graph for just one basic block then use asm-regalloc-stages instead.
dumpIfSet_dyn dflags
- Opt_D_dump_asm_conflicts "(asm-conflicts) Register conflict graph"
+ Opt_D_dump_asm_conflicts "Register conflict graph"
$ Color.dotGraph Color.regDotColor trivColorable
$ foldl Color.union Color.initGraph
$ catMaybes $ map cdColoredGraph dump
-
- -- Drop native code gen statistics.
- -- This is potentially a large amount of information, so we make a new file instead
- -- of dumping it to stdout.
+ -- Drop native code generator statistics.
+ -- This is potentially a large amount of information, and we want to be able
+ -- to collect it while running nofib. Drop a new file instead of emitting
+ -- it to stdout/stderr.
--
when (dopt Opt_D_drop_asm_stats dflags)
$ do -- make the drop file name based on the object file name
-- slurp out all the regalloc stats
let stats = concat $ catMaybes $ map cdRegAllocStats dump
- ---- Spiller
- -- slurp out the stats from all the spiller stages
- let spillStats = [ s | s@RegAllocStatsSpill{} <- stats]
-
- -- build a map of how many spill load/stores were inserted for each vreg
- let spillLS = foldl' (plusUFM_C Spill.accSpillLS) emptyUFM
- $ map (Spill.spillLoadStore . raSpillStats) spillStats
+ -- build a global conflict graph
+ let graph = foldl Color.union Color.initGraph $ map Color.raGraph stats
- -- print the count of load/spills as a tuple so we can read back from the file easilly
- let pprSpillLS :: (Reg, Int, Int) -> SDoc
- pprSpillLS (r, loads, stores) =
- (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
+ -- pretty print the various sections and write out the file.
+ let outSpills = Color.pprStatsSpills stats
+ let outLife = Color.pprStatsLifetimes stats
+ let outConflict = Color.pprStatsConflict stats
+ let outScatter = Color.pprStatsLifeConflict stats graph
-
- let outSpill = ( text "-- (spills-added)"
- $$ text "-- Spill instructions inserted for each virtual reg."
- $$ text "-- (reg_name, spill_loads_added, spill_stores_added)."
- $$ (vcat $ map pprSpillLS $ eltsUFM spillLS)
- $$ text "\n")
-
- ---- Lifetimes
- -- slurp out the maps of all the reg lifetimes
- let lifetimes = map raLifetimes stats
- let lifeMap = foldl' plusUFM emptyUFM $ map raLifetimes stats
- let lifeBins = binLifetimeCount lifeMap
-
- let outLife = ( text "-- (vreg-population-lifetimes)"
- $$ text "-- Number of vregs which lived for a certain number of instructions"
- $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
- $$ (vcat $ map ppr $ eltsUFM lifeBins)
- $$ text "\n")
-
- -- write out the file
writeFile dropFile
- (showSDoc $ vcat [outSpill, outLife])
-
- return ()
+ (showSDoc $ vcat [outSpills, outLife, outConflict, outScatter])
return ()
projects / ghc-hetmet.git / blobdiff