compiler/cmm/CmmPipeline.hs

   1 {-# OPTIONS_GHC -XNoMonoLocalBinds #-}
   2 -- Norman likes local bindings
   3 -- If this module lives on I'd like to get rid of this flag in due course
   4
   5 module CmmPipeline (
   6   -- | Converts C-- with an implicit stack and native C-- calls into
   7   -- optimized, CPS converted and native-call-less C--.  The latter
   8   -- C-- can be used to generate assembly.
   9   cmmPipeline
  10 ) where
  11
  12 import CLabel
  13 import Cmm
  14 import CmmDecl
  15 import CmmBuildInfoTables
  16 import CmmCommonBlockElim
  17 import CmmProcPoint
  18 import CmmSpillReload
  19 import CmmRewriteAssignments
  20 import CmmStackLayout
  21 import CmmContFlowOpt
  22 import OptimizationFuel
  23
  24 import DynFlags
  25 import ErrUtils
  26 import HscTypes
  27 import Data.Maybe
  28 import Control.Monad
  29 import Data.Map (Map)
  30 import qualified Data.Map as Map
  31 import Outputable
  32 import StaticFlags
  33
  34 -----------------------------------------------------------------------------
  35 -- | Top level driver for C-- pipeline
  36 -----------------------------------------------------------------------------
  37 -- There are two complications here:
  38 -- 1. We need to compile the procedures in two stages because we need
  39 --    an analysis of the procedures to tell us what CAFs they use.
  40 --    The first stage returns a map from procedure labels to CAFs,
  41 --    along with a closure that will compute SRTs and attach them to
  42 --    the compiled procedures.
  43 --    The second stage is to combine the CAF information into a top-level
  44 --    CAF environment mapping non-static closures to the CAFs they keep live,
  45 --    then pass that environment to the closures returned in the first
  46 --    stage of compilation.
  47 -- 2. We need to thread the module's SRT around when the SRT tables
  48 --    are computed for each procedure.
  49 --    The SRT needs to be threaded because it is grown lazily.
  50 -- 3. We run control flow optimizations twice, once before any pipeline
  51 --    work is done, and once again at the very end on all of the
  52 --    resulting C-- blocks.  EZY: It's unclear whether or not whether
  53 --    we actually need to do the initial pass.
  54 cmmPipeline  :: HscEnv -- Compilation env including
  55                        -- dynamic flags: -dcmm-lint -ddump-cps-cmm
  56              -> (TopSRT, [Cmm])    -- SRT table and accumulating list of compiled procs
  57              -> Cmm                -- Input C-- with Procedures
  58              -> IO (TopSRT, [Cmm]) -- Output CPS transformed C--
  59 cmmPipeline hsc_env (topSRT, rst) prog =
  60   do let dflags = hsc_dflags hsc_env
  61          (Cmm tops) = runCmmContFlowOpts prog
  62      showPass dflags "CPSZ"
  63      (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
  64      let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
  65      (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
  66      let cmms = Cmm (reverse (concat tops))
  67      dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
  68      -- SRT is not affected by control flow optimization pass
  69      let prog' = map runCmmContFlowOpts (cmms : rst)
  70      return (topSRT, prog')
  71
  72 {- [Note global fuel]
  73 ~~~~~~~~~~~~~~~~~~~~~
  74 The identity and the last pass are stored in
  75 mutable reference cells in an 'HscEnv' and are
  76 global to one compiler session.
  77 -}
  78
  79 -- EZY: It might be helpful to have an easy way of dumping the "pre"
  80 -- input for any given phase, besides just turning it all on with
  81 -- -ddump-cmmz
  82
  83 cpsTop :: HscEnv -> CmmTop -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmTop)])
  84 cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
  85 cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
  86     do
  87        -- Why bother doing these early: dualLivenessWithInsertion,
  88        -- insertLateReloads, rewriteAssignments?
  89
  90        ----------- Eliminate common blocks -------------------
  91        g <- return $ elimCommonBlocks g
  92        dump Opt_D_dump_cmmz_cbe "Post common block elimination" g
  93        -- Any work storing block Labels must be performed _after_ elimCommonBlocks
  94
  95        ----------- Proc points -------------------
  96        let callPPs = callProcPoints g
  97        procPoints <- run $ minimalProcPointSet callPPs g
  98        g <- run $ addProcPointProtocols callPPs procPoints g
  99        dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
 100
 101        ----------- Spills and reloads -------------------
 102        g <- run $ dualLivenessWithInsertion procPoints g
 103        dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
 104
 105        ----------- Sink and inline assignments -------------------
 106        g <- runOptimization $ rewriteAssignments g
 107        dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
 108
 109        ----------- Eliminate dead assignments -------------------
 110        -- Remove redundant reloads (and any other redundant asst)
 111        g <- runOptimization $ removeDeadAssignmentsAndReloads procPoints g
 112        dump Opt_D_dump_cmmz_dead "Post Dead Assignment Elimination" g
 113
 114        ----------- Zero dead stack slots (Debug only) ---------------
 115        -- Debugging: stubbing slots on death can cause crashes early
 116        g <- if opt_StubDeadValues
 117                 then run $ stubSlotsOnDeath g
 118                 else return g
 119        dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
 120
 121        --------------- Stack layout ----------------
 122        slotEnv <- run $ liveSlotAnal g
 123        let spEntryMap = getSpEntryMap entry_off g
 124        mbpprTrace "live slot analysis results: " (ppr slotEnv) $ return ()
 125        let areaMap = layout procPoints spEntryMap slotEnv entry_off g
 126        mbpprTrace "areaMap" (ppr areaMap) $ return ()
 127
 128        ------------  Manifest the stack pointer --------
 129        g  <- run $ manifestSP spEntryMap areaMap entry_off g
 130        dump Opt_D_dump_cmmz_sp "Post manifestSP" g
 131        -- UGH... manifestSP can require updates to the procPointMap.
 132        -- We can probably do something quicker here for the update...
 133
 134        ------------- Split into separate procedures ------------
 135        procPointMap  <- run $ procPointAnalysis procPoints g
 136        dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
 137        gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
 138                                        (CmmProc h l g)
 139        mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
 140
 141        ------------- More CAFs and foreign calls ------------
 142        cafEnv <- run $ cafAnal g
 143        let localCAFs = catMaybes $ map (localCAFInfo cafEnv) gs
 144        mbpprTrace "localCAFs" (ppr localCAFs) $ return ()
 145
 146        gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
 147        mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
 148
 149        -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
 150        gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
 151        mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
 152        gs <- return $ map (bundleCAFs cafEnv) gs
 153        mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
 154        return (localCAFs, gs)
 155   where dflags = hsc_dflags hsc_env
 156         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
 157         dump f txt g = do
 158             -- ToDo: No easy way of say "dump all the cmmz, *and* split
 159             -- them into files."  Also, -ddump-cmmz doesn't play nicely
 160             -- with -ddump-to-file, since the headers get omitted.
 161             dumpIfSet_dyn dflags f txt (ppr g)
 162             when (not (dopt f dflags)) $
 163                 dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (ppr g)
 164         -- Runs a required transformation/analysis
 165         run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
 166         -- Runs an optional transformation/analysis (and should
 167         -- thus be subject to optimization fuel)
 168         runOptimization = runFuelIO (hsc_OptFuel hsc_env)
 169
 170 -- This probably belongs in CmmBuildInfoTables?
 171 -- We're just finishing the job here: once we know what CAFs are defined
 172 -- in non-static closures, we can build the SRTs.
 173 toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTop]])
 174                  -> [(CAFSet, CmmTop)] -> IO (TopSRT, [[CmmTop]])
 175 toTops hsc_env topCAFEnv (topSRT, tops) gs =
 176   do let setSRT (topSRT, rst) g =
 177            do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g
 178               return (topSRT, gs : rst)
 179      (topSRT, gs') <- runFuelIO (hsc_OptFuel hsc_env) $ foldM setSRT (topSRT, []) gs
 180      return (topSRT, concat gs' : tops)