import RegAllocInfo
import NCGMonad
import PositionIndependentCode
-import RegAllocLinear
import RegLiveness
import RegCoalesce
+import qualified RegAllocLinear as Linear
import qualified RegAllocColor as Color
+import qualified RegAllocStats as Color
import qualified GraphColor as Color
import Cmm
import StaticFlags ( opt_Static, opt_PIC )
import Util
import Config ( cProjectVersion )
+import Module
import Digraph
import qualified Pretty
-- DEBUGGING ONLY
--import OrdList
-#ifdef NCG_DEBUG
-import List ( intersperse )
-#endif
-
+import Data.List
import Data.Int
import Data.Word
import Data.Bits
import Data.Maybe
import GHC.Exts
+import Control.Monad
{-
The native-code generator has machine-independent and
-- NB. We *lazilly* compile each block of code for space reasons.
--------------------
-nativeCodeGen :: DynFlags -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
-nativeCodeGen dflags cmms us
+nativeCodeGen :: DynFlags -> Module -> ModLocation -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
+nativeCodeGen dflags mod modLocation cmms us
= let (res, _) = initUs us $
cgCmm (concat (map add_split cmms))
in
case res of { (dump, insn_sdoc, imports) -> do
- -- stripe across the outputs for each block so all the information for a
- -- certain stage is concurrent in the dumps.
-
- 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"
- (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
-
- dumpIfSet_dyn dflags
- Opt_D_dump_asm_liveness "(asm-liveness) Liveness info added"
- (vcat $ map (ppr . cdLiveness) dump)
-
- dumpIfSet_dyn dflags
- Opt_D_dump_asm_coalesce "(asm-coalesce) Register moves coalesced."
- (vcat $ map (ppr . cdCoalesce) dump)
-
- dumpIfSet_dyn dflags
- Opt_D_dump_asm_regalloc "(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, (code, graph)) ->
- ( text "-- Stage " <> int stage
- $$ ppr code
- $$ Color.dotGraph Color.regDotColor trivColorable graph))
- (zip [0..] codeGraphs)))
- $ map cdCodeGraphs 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"
- $ Color.dotGraph Color.regDotColor trivColorable
- $ foldl Color.union Color.initGraph
- $ catMaybes $ map cdColoredGraph dump
-
+ cmmNativeGenDump dflags mod modLocation dump
return (insn_sdoc Pretty.$$ dyld_stubs imports
{ cdCmmOpt :: RawCmmTop
, cdNative :: [NatCmmTop]
, cdLiveness :: [LiveCmmTop]
- , cdCoalesce :: [LiveCmmTop]
- , cdCodeGraphs :: [([LiveCmmTop], Color.Graph Reg RegClass Reg)]
+ , cdCoalesce :: Maybe [LiveCmmTop]
+ , cdRegAllocStats :: Maybe [Color.RegAllocStats]
+ , cdRegAllocStatsLinear :: [Linear.RegAllocStats]
, cdColoredGraph :: Maybe (Color.Graph Reg RegClass Reg)
, cdAlloced :: [NatCmmTop] }
| dopt opt dflags = a
| otherwise = b
+dchooses dflags opts a b
+ | or $ map ( (flip dopt) dflags) opts = a
+ | otherwise = b
-- | Complete native code generation phase for a single top-level chunk of Cmm.
-- 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_codeGraphs, ppr_coloredGraph)
+ ( alloced, ppr_alloced, ppr_coalesce
+ , ppr_regAllocStats, ppr_regAllocStatsLinear, ppr_coloredGraph)
<- (\withLiveness
-> {-# SCC "regAlloc" #-}
do
coalesced <- regCoalesce withLiveness
-- graph coloring register allocation
- (alloced, codeGraphs)
+ (alloced, regAllocStats)
<- Color.regAlloc
alloc_regs
(mkUniqSet [0..maxSpillSlots])
coalesced
return ( alloced
- , dchoose dflags Opt_D_dump_asm_regalloc alloced []
- , dchoose dflags Opt_D_dump_asm_coalesce coalesced []
- , dchoose dflags Opt_D_dump_asm_regalloc_stages codeGraphs []
- , dchoose dflags Opt_D_dump_asm_conflicts Nothing 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)
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
, cdNative = ppr_native
, cdLiveness = ppr_withLiveness
, cdCoalesce = ppr_coalesce
- , cdCodeGraphs = ppr_codeGraphs
+ , cdRegAllocStats = ppr_regAllocStats
+ , cdRegAllocStatsLinear = ppr_regAllocStatsLinear
, cdColoredGraph = ppr_coloredGraph
, cdAlloced = ppr_alloced }
#endif
+-- Dump output of native code generator passes
+-- stripe across the outputs for each block so all the information for a
+-- certain stage is concurrent in the dumps.
+--
+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 "Native code"
+ (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
+
+ dumpIfSet_dyn dflags
+ Opt_D_dump_asm_liveness "Liveness annotations added"
+ (vcat $ map (ppr . cdLiveness) dump)
+
+ dumpIfSet_dyn dflags
+ 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 "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.
+ 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 "Register conflict graph"
+ $ Color.dotGraph Color.regDotColor trivColorable
+ $ foldl Color.union Color.initGraph
+ $ catMaybes $ map cdColoredGraph dump
+
+ -- 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
+ let dropFile = (init $ ml_obj_file modLocation) ++ "drop-asm-stats"
+
+ -- slurp out all the regalloc stats
+ let stats = concat $ catMaybes $ map cdRegAllocStats dump
+
+ -- build a global conflict graph
+ let graph = foldl Color.union Color.initGraph $ map Color.raGraph stats
+
+ -- 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
+
+ writeFile dropFile
+ (showSDoc $ vcat [outSpills, outLife, outConflict, outScatter])
+
+ return ()
+
-- -----------------------------------------------------------------------------
-- Sequencing the basic blocks