5effa6ca77d2d15036e909f7fb77c497cf7f832a
[ghc.git] / 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 CmmLive
16 import CmmBuildInfoTables
17 import CmmCommonBlockElim
18 import CmmProcPoint
19 import CmmSpillReload
20 import CmmRewriteAssignments
21 import CmmStackLayout
22 import CmmContFlowOpt
23 import OptimizationFuel
24
25 import DynFlags
26 import ErrUtils
27 import HscTypes
28 import Data.Maybe
29 import Control.Monad
30 import Data.Map (Map)
31 import qualified Data.Map as Map
32 import Outputable
33 import StaticFlags
34
35 -----------------------------------------------------------------------------
36 -- | Top level driver for C-- pipeline
37 -----------------------------------------------------------------------------
38 -- There are two complications here:
39 -- 1. We need to compile the procedures in two stages because we need
40 -- an analysis of the procedures to tell us what CAFs they use.
41 -- The first stage returns a map from procedure labels to CAFs,
42 -- along with a closure that will compute SRTs and attach them to
43 -- the compiled procedures.
44 -- The second stage is to combine the CAF information into a top-level
45 -- CAF environment mapping non-static closures to the CAFs they keep live,
46 -- then pass that environment to the closures returned in the first
47 -- stage of compilation.
48 -- 2. We need to thread the module's SRT around when the SRT tables
49 -- are computed for each procedure.
50 -- The SRT needs to be threaded because it is grown lazily.
51 -- 3. We run control flow optimizations twice, once before any pipeline
52 -- work is done, and once again at the very end on all of the
53 -- resulting C-- blocks. EZY: It's unclear whether or not whether
54 -- we actually need to do the initial pass.
55 cmmPipeline :: HscEnv -- Compilation env including
56 -- dynamic flags: -dcmm-lint -ddump-cps-cmm
57 -> (TopSRT, [Cmm]) -- SRT table and accumulating list of compiled procs
58 -> Cmm -- Input C-- with Procedures
59 -> 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 showPass dflags "CPSZ"
64 (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
65 let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
66 (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
67 let cmms = Cmm (reverse (concat tops))
68 dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
69 -- SRT is not affected by control flow optimization pass
70 let prog' = map runCmmContFlowOpts (cmms : rst)
71 return (topSRT, prog')
72
73 {- [Note global fuel]
74 ~~~~~~~~~~~~~~~~~~~~~
75 The identity and the last pass are stored in
76 mutable reference cells in an 'HscEnv' and are
77 global to one compiler session.
78 -}
79
80 -- EZY: It might be helpful to have an easy way of dumping the "pre"
81 -- input for any given phase, besides just turning it all on with
82 -- -ddump-cmmz
83
84 cpsTop :: HscEnv -> CmmTop -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmTop)])
85 cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
86 cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
87 do
88 -- Why bother doing these early: dualLivenessWithInsertion,
89 -- insertLateReloads, rewriteAssignments?
90
91 ----------- Eliminate common blocks -------------------
92 g <- return $ elimCommonBlocks g
93 dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
94 -- Any work storing block Labels must be performed _after_ elimCommonBlocks
95
96 ----------- Proc points -------------------
97 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 ----------- Sink and inline assignments -------------------
107 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 ----------- 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 dumpPlatform platform 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 dumpPlatform platform 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_ (dumpPlatform platform 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_ (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 dump f = dumpWith ppr f
159 dumpPlatform platform = dumpWith (pprPlatform platform)
160 dumpWith pprFun f txt g = do
161 -- ToDo: No easy way of say "dump all the cmmz, *and* split
162 -- them into files." Also, -ddump-cmmz doesn't play nicely
163 -- 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 -- Runs a required transformation/analysis
168 run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
169 -- Runs an optional transformation/analysis (and should
170 -- thus be subject to optimization fuel)
171 runOptimization = runFuelIO (hsc_OptFuel hsc_env)
172
173 -- This probably belongs in CmmBuildInfoTables?
174 -- We're just finishing the job here: once we know what CAFs are defined
175 -- in non-static closures, we can build the SRTs.
176 toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTop]])
177 -> [(CAFSet, CmmTop)] -> IO (TopSRT, [[CmmTop]])
178 toTops hsc_env topCAFEnv (topSRT, tops) gs =
179 do let setSRT (topSRT, rst) g =
180 do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g
181 return (topSRT, gs : rst)
182 (topSRT, gs') <- runFuelIO (hsc_OptFuel hsc_env) $ foldM setSRT (topSRT, []) gs
183 return (topSRT, concat gs' : tops)