CmmPipeline.hs 8.83 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 CmmLive
15 16
import CmmBuildInfoTables
import CmmCommonBlockElim
17
import CmmProcPoint
18
import CmmSpillReload
19
import CmmRewriteAssignments
20
import CmmStackLayout
21
import CmmContFlowOpt
22
import OptimizationFuel
23 24 25

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

34
-----------------------------------------------------------------------------
35
-- | Top level driver for C-- pipeline
36
-----------------------------------------------------------------------------
37 38 39 40 41 42 43 44 45 46 47 48 49
-- 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.
50 51 52 53 54
-- 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
55
                       -- dynamic flags: -dcmm-lint -ddump-cps-cmm
Simon Peyton Jones's avatar
Simon Peyton Jones committed
56 57 58
             -> (TopSRT, [CmmGroup])    -- SRT table and accumulating list of compiled procs
             -> CmmGroup             -- Input C-- with Procedures
             -> IO (TopSRT, [CmmGroup]) -- Output CPS transformed C--
59
cmmPipeline hsc_env (topSRT, rst) prog =
60
  do let dflags = hsc_dflags hsc_env
61
     --
62
     showPass dflags "CPSZ"
63

64
     (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) prog
Simon Peyton Jones's avatar
Simon Peyton Jones committed
65
     -- tops :: [[(CmmDecl,CAFSet]]  (one list per group)
66

67
     let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
68 69

     -- folding over the groups
70
     (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
71

72 73
     let cmms :: CmmGroup
         cmms = reverse (concat tops)
74

75
     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
76

77
     -- SRT is not affected by control flow optimization pass
78 79 80
     let prog' = runCmmContFlowOpts cmms

     return (topSRT, prog' : rst)
81 82 83 84 85 86 87 88

{- [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.
-}

89 90 91 92
-- 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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
93
cpsTop :: HscEnv -> CmmDecl -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmDecl)])
94 95 96
cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
    do
97 98
       -- Why bother doing these early: dualLivenessWithInsertion,
       -- insertLateReloads, rewriteAssignments?
99

100 101 102 103
       ----------- Control-flow optimisations ---------------
       g <- return $ cmmCfgOpts g
       dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations" g

104 105
       ----------- Eliminate common blocks -------------------
       g <- return $ elimCommonBlocks g
106 107 108
       dump Opt_D_dump_cmmz_cbe "Post common block elimination" g
       -- Any work storing block Labels must be performed _after_
       -- elimCommonBlocks
109 110 111

       ----------- Proc points -------------------
       let callPPs = callProcPoints g
112
       procPoints <- run $ minimalProcPointSet (targetPlatform dflags) callPPs g
113
       g <- run $ addProcPointProtocols callPPs procPoints g
114
       dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
115 116

       ----------- Spills and reloads -------------------
117
       g <- run $ dualLivenessWithInsertion procPoints g
118
       dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
119

120
       ----------- Sink and inline assignments -------------------
Ian Lynagh's avatar
Ian Lynagh committed
121
       g <- runOptimization $ rewriteAssignments platform g
122
       dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
123 124

       ----------- Eliminate dead assignments -------------------
125
       g <- runOptimization $ removeDeadAssignments g
126
       dump Opt_D_dump_cmmz_dead "Post remove dead assignments" g
127 128 129 130 131 132

       ----------- 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
133
       dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
134 135 136

       --------------- Stack layout ----------------
       slotEnv <- run $ liveSlotAnal g
137
       let spEntryMap = getSpEntryMap entry_off g
138
       mbpprTrace "live slot analysis results: " (ppr slotEnv) $ return ()
139
       let areaMap = layout procPoints spEntryMap slotEnv entry_off g
140 141 142
       mbpprTrace "areaMap" (ppr areaMap) $ return ()

       ------------  Manifest the stack pointer --------
143
       g  <- run $ manifestSP spEntryMap areaMap entry_off g
144
       dump Opt_D_dump_cmmz_sp "Post manifestSP" g
145 146 147 148 149
       -- 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
150
       dumpWith ppr Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
151 152
       gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
                                       (CmmProc h l g)
153
       mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
154 155

       ------------- More CAFs and foreign calls ------------
156 157 158
       cafEnv <- run $ cafAnal platform g
       let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs
       mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return ()
159 160

       gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
161 162 163 164 165
       mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs

       ----------- Control-flow optimisations ---------------
       gs <- return $ map cmmCfgOpts gs
       mapM_ (dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations") gs
166 167

       -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
168
       gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
169
       mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
170
       gs <- return $ map (bundleCAFs cafEnv) gs
171
       mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
172
       return (localCAFs, gs)
173

Simon Peyton Jones's avatar
Simon Peyton Jones committed
174
              -- gs        :: [ (CAFSet, CmmDecl) ]
175 176
              -- localCAFs :: [ (CLabel, CAFSet) ] -- statics filtered out(?)

177 178
  where dflags = hsc_dflags hsc_env
        mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
179 180
        dump = dumpGraph dflags

181 182 183 184 185 186
        -- 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)

187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202

dumpGraph :: DynFlags -> DynFlag -> CmmGraph -> IO ()
dumpGraph dflags flag g = do
  cmmLint g
  dumpWith (pprPlatform platform)
  where
        platform = targetPlatform dflags

        dumpWith pprFun flag txt g = do
            -- 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.
            dumpIfSet_dyn dflags flag txt (pprFun g)
            when (not (dopt flag dflags)) $
                dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (pprFun g)

203 204 205
-- 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.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
206 207
toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmDecl]])
                 -> [(CAFSet, CmmDecl)] -> IO (TopSRT, [[CmmDecl]])
208 209 210 211 212 213
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)