CmmPipeline.hs 8.33 KB
Newer Older
1 2 3
{-# OPTIONS_GHC -XNoMonoLocalBinds #-}
-- Norman likes local bindings
-- If this module lives on I'd like to get rid of this flag in due course
4

Edward Z. Yang's avatar
Edward Z. Yang committed
5
module CmmPipeline (
6 7 8 9
  -- | Converts C-- with an implicit stack and native C-- calls into
  -- optimized, CPS converted and native-call-less C--.  The latter
  -- C-- can be used to generate assembly.
  cmmPipeline
10
) where
11

12
import CLabel
13
import Cmm
14
import CmmDecl
15
import CmmLive
16 17
import CmmBuildInfoTables
import CmmCommonBlockElim
18
import CmmProcPoint
19
import CmmSpillReload
20
import CmmRewriteAssignments
21
import CmmStackLayout
22
import CmmContFlowOpt
23
import OptimizationFuel
24 25 26

import DynFlags
import ErrUtils
27 28
import HscTypes
import Data.Maybe
Ian Lynagh's avatar
Ian Lynagh committed
29
import Control.Monad
30 31 32 33
import Data.Map (Map)
import qualified Data.Map as Map
import Outputable
import StaticFlags
34

35
-----------------------------------------------------------------------------
36
-- | Top level driver for C-- pipeline
37
-----------------------------------------------------------------------------
38 39 40 41 42 43 44 45 46 47 48 49 50
-- There are two complications here:
-- 1. We need to compile the procedures in two stages because we need
--    an analysis of the procedures to tell us what CAFs they use.
--    The first stage returns a map from procedure labels to CAFs,
--    along with a closure that will compute SRTs and attach them to
--    the compiled procedures.
--    The second stage is to combine the CAF information into a top-level
--    CAF environment mapping non-static closures to the CAFs they keep live,
--    then pass that environment to the closures returned in the first
--    stage of compilation.
-- 2. We need to thread the module's SRT around when the SRT tables
--    are computed for each procedure.
--    The SRT needs to be threaded because it is grown lazily.
51 52 53 54 55
-- 3. We run control flow optimizations twice, once before any pipeline
--    work is done, and once again at the very end on all of the
--    resulting C-- blocks.  EZY: It's unclear whether or not whether
--    we actually need to do the initial pass.
cmmPipeline  :: HscEnv -- Compilation env including
56 57 58 59
                       -- dynamic flags: -dcmm-lint -ddump-cps-cmm
             -> (TopSRT, [Cmm])    -- SRT table and accumulating list of compiled procs
             -> Cmm                -- Input C-- with Procedures
             -> IO (TopSRT, [Cmm]) -- Output CPS transformed C--
60
cmmPipeline hsc_env (topSRT, rst) prog =
61
  do let dflags = hsc_dflags hsc_env
62
         (Cmm tops) = runCmmContFlowOpts prog
63 64 65 66 67
     showPass dflags "CPSZ"
     (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
     let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
     (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
     let cmms = Cmm (reverse (concat tops))
68
     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
69 70 71
     -- SRT is not affected by control flow optimization pass
     let prog' = map runCmmContFlowOpts (cmms : rst)
     return (topSRT, prog')
72 73 74 75 76 77 78 79

{- [Note global fuel]
~~~~~~~~~~~~~~~~~~~~~
The identity and the last pass are stored in
mutable reference cells in an 'HscEnv' and are
global to one compiler session.
-}

80 81 82 83
-- EZY: It might be helpful to have an easy way of dumping the "pre"
-- input for any given phase, besides just turning it all on with
-- -ddump-cmmz

84 85 86 87
cpsTop :: HscEnv -> CmmTop -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmTop)])
cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
    do
88 89
       -- Why bother doing these early: dualLivenessWithInsertion,
       -- insertLateReloads, rewriteAssignments?
90

91 92
       ----------- Eliminate common blocks -------------------
       g <- return $ elimCommonBlocks g
93
       dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
94 95 96 97
       -- Any work storing block Labels must be performed _after_ elimCommonBlocks

       ----------- Proc points -------------------
       let callPPs = callProcPoints g
98
       procPoints <- run $ minimalProcPointSet (targetPlatform dflags) callPPs g
99
       g <- run $ addProcPointProtocols callPPs procPoints g
100
       dumpPlatform platform Opt_D_dump_cmmz_proc "Post Proc Points Added" g
101 102

       ----------- Spills and reloads -------------------
103
       g <- run $ dualLivenessWithInsertion procPoints g
104
       dumpPlatform platform Opt_D_dump_cmmz_spills "Post spills and reloads" g
105

106 107
       ----------- Sink and inline assignments -------------------
       g <- runOptimization $ rewriteAssignments g
108
       dumpPlatform platform Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
109 110

       ----------- Eliminate dead assignments -------------------
111
       g <- runOptimization $ removeDeadAssignments g
112
       dumpPlatform platform Opt_D_dump_cmmz_dead "Post remove dead assignments" g
113 114 115 116 117 118

       ----------- Zero dead stack slots (Debug only) ---------------
       -- Debugging: stubbing slots on death can cause crashes early
       g <- if opt_StubDeadValues
                then run $ stubSlotsOnDeath g
                else return g
119
       dumpPlatform platform Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
120 121 122

       --------------- Stack layout ----------------
       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 127 128
       mbpprTrace "areaMap" (ppr areaMap) $ return ()

       ------------  Manifest the stack pointer --------
129
       g  <- run $ manifestSP spEntryMap areaMap entry_off g
130
       dumpPlatform platform Opt_D_dump_cmmz_sp "Post manifestSP" g
131 132 133 134 135
       -- UGH... manifestSP can require updates to the procPointMap.
       -- We can probably do something quicker here for the update...

       ------------- Split into separate procedures ------------
       procPointMap  <- run $ procPointAnalysis procPoints g
136
       dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
137 138
       gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
                                       (CmmProc h l g)
139
       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_split "Post splitting") gs
140 141 142 143 144 145 146

       ------------- More CAFs and foreign calls ------------
       cafEnv <- run $ cafAnal g
       let localCAFs = catMaybes $ map (localCAFInfo cafEnv) gs
       mbpprTrace "localCAFs" (ppr localCAFs) $ return ()

       gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
147
       mapM_ (dumpPlatform platform 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_ (dumpPlatform platform Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
152
       gs <- return $ map (bundleCAFs cafEnv) gs
153
       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
154
       return (localCAFs, gs)
155
  where dflags = hsc_dflags hsc_env
156
        platform = targetPlatform dflags
157
        mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
158 159 160
        dump f = dumpWith ppr f
        dumpPlatform platform = dumpWith (pprPlatform platform)
        dumpWith pprFun f txt g = do
161 162 163
            -- ToDo: No easy way of say "dump all the cmmz, *and* split
            -- them into files."  Also, -ddump-cmmz doesn't play nicely
            -- with -ddump-to-file, since the headers get omitted.
164
            dumpIfSet_dyn dflags f txt (pprFun g)
165
            when (not (dopt f dflags)) $
166
                dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (pprFun g)
167 168 169 170 171 172
        -- Runs a required transformation/analysis
        run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
        -- Runs an optional transformation/analysis (and should
        -- thus be subject to optimization fuel)
        runOptimization = runFuelIO (hsc_OptFuel hsc_env)

173 174 175 176 177 178 179 180 181 182 183
-- This probably belongs in CmmBuildInfoTables?
-- We're just finishing the job here: once we know what CAFs are defined
-- in non-static closures, we can build the SRTs.
toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTop]])
                 -> [(CAFSet, CmmTop)] -> IO (TopSRT, [[CmmTop]])
toTops hsc_env topCAFEnv (topSRT, tops) gs =
  do let setSRT (topSRT, rst) g =
           do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g
              return (topSRT, gs : rst)
     (topSRT, gs') <- runFuelIO (hsc_OptFuel hsc_env) $ foldM setSRT (topSRT, []) gs
     return (topSRT, concat gs' : tops)