3d98d0a9ec706046f9f3e5792f7f30d7010be0e7
[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 CmmLive
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, [CmmGroup]) -- SRT table and accumulating list of compiled procs
57 -> CmmGroup -- Input C-- with Procedures
58 -> 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 let tops = runCmmContFlowOpts prog
65 (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
66 -- tops :: [[(CmmDecl,CAFSet]] (one list per group)
67
68 let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
69
70 -- folding over the groups
71 (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
72
73 let cmms :: CmmGroup
74 cmms = reverse (concat tops)
75
76 dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
77
78 -- SRT is not affected by control flow optimization pass
79 let prog' = runCmmContFlowOpts cmms
80
81 return (topSRT, prog' : rst)
82
83 {- [Note global fuel]
84 ~~~~~~~~~~~~~~~~~~~~~
85 The identity and the last pass are stored in
86 mutable reference cells in an 'HscEnv' and are
87 global to one compiler session.
88 -}
89
90 -- EZY: It might be helpful to have an easy way of dumping the "pre"
91 -- input for any given phase, besides just turning it all on with
92 -- -ddump-cmmz
93
94 cpsTop :: HscEnv -> CmmDecl -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmDecl)])
95 cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
96 cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
97 do
98 -- Why bother doing these early: dualLivenessWithInsertion,
99 -- insertLateReloads, rewriteAssignments?
100
101 ----------- Eliminate common blocks -------------------
102 g <- return $ elimCommonBlocks g
103 dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
104 -- Any work storing block Labels must be performed _after_ elimCommonBlocks
105
106 ----------- Proc points -------------------
107 let callPPs = callProcPoints g
108 procPoints <- run $ minimalProcPointSet (targetPlatform dflags) callPPs g
109 g <- run $ addProcPointProtocols callPPs procPoints g
110 dumpPlatform platform Opt_D_dump_cmmz_proc "Post Proc Points Added" g
111
112 ----------- Spills and reloads -------------------
113 g <- run $ dualLivenessWithInsertion procPoints g
114 dumpPlatform platform Opt_D_dump_cmmz_spills "Post spills and reloads" g
115
116 ----------- Sink and inline assignments -------------------
117 g <- runOptimization $ rewriteAssignments platform g
118 dumpPlatform platform Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
119
120 ----------- Eliminate dead assignments -------------------
121 g <- runOptimization $ removeDeadAssignments g
122 dumpPlatform platform Opt_D_dump_cmmz_dead "Post remove dead assignments" g
123
124 ----------- Zero dead stack slots (Debug only) ---------------
125 -- Debugging: stubbing slots on death can cause crashes early
126 g <- if opt_StubDeadValues
127 then run $ stubSlotsOnDeath g
128 else return g
129 dumpPlatform platform Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
130
131 --------------- Stack layout ----------------
132 slotEnv <- run $ liveSlotAnal g
133 let spEntryMap = getSpEntryMap entry_off g
134 mbpprTrace "live slot analysis results: " (ppr slotEnv) $ return ()
135 let areaMap = layout procPoints spEntryMap slotEnv entry_off g
136 mbpprTrace "areaMap" (ppr areaMap) $ return ()
137
138 ------------ Manifest the stack pointer --------
139 g <- run $ manifestSP spEntryMap areaMap entry_off g
140 dumpPlatform platform Opt_D_dump_cmmz_sp "Post manifestSP" g
141 -- UGH... manifestSP can require updates to the procPointMap.
142 -- We can probably do something quicker here for the update...
143
144 ------------- Split into separate procedures ------------
145 procPointMap <- run $ procPointAnalysis procPoints g
146 dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
147 gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
148 (CmmProc h l g)
149 mapM_ (dumpPlatform platform Opt_D_dump_cmmz_split "Post splitting") gs
150
151 ------------- More CAFs and foreign calls ------------
152 cafEnv <- run $ cafAnal platform g
153 let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs
154 mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return ()
155
156 gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
157 mapM_ (dumpPlatform platform Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
158
159 -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
160 gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
161 mapM_ (dumpPlatform platform Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
162 gs <- return $ map (bundleCAFs cafEnv) gs
163 mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
164 return (localCAFs, gs)
165
166 -- gs :: [ (CAFSet, CmmDecl) ]
167 -- localCAFs :: [ (CLabel, CAFSet) ] -- statics filtered out(?)
168
169 where dflags = hsc_dflags hsc_env
170 platform = targetPlatform dflags
171 mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
172 dump f = dumpWith ppr f
173 dumpPlatform platform = dumpWith (pprPlatform platform)
174 dumpWith pprFun f txt g = do
175 -- ToDo: No easy way of say "dump all the cmmz, *and* split
176 -- them into files." Also, -ddump-cmmz doesn't play nicely
177 -- with -ddump-to-file, since the headers get omitted.
178 dumpIfSet_dyn dflags f txt (pprFun g)
179 when (not (dopt f dflags)) $
180 dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (pprFun g)
181 -- Runs a required transformation/analysis
182 run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
183 -- Runs an optional transformation/analysis (and should
184 -- thus be subject to optimization fuel)
185 runOptimization = runFuelIO (hsc_OptFuel hsc_env)
186
187 -- This probably belongs in CmmBuildInfoTables?
188 -- We're just finishing the job here: once we know what CAFs are defined
189 -- in non-static closures, we can build the SRTs.
190 toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmDecl]])
191 -> [(CAFSet, CmmDecl)] -> IO (TopSRT, [[CmmDecl]])
192 toTops hsc_env topCAFEnv (topSRT, tops) gs =
193 do let setSRT (topSRT, rst) g =
194 do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g
195 return (topSRT, gs : rst)
196 (topSRT, gs') <- runFuelIO (hsc_OptFuel hsc_env) $ foldM setSRT (topSRT, []) gs
197 return (topSRT, concat gs' : tops)