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
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.
15 import CmmBuildInfoTables
16 import CmmCommonBlockElim
19 import CmmRewriteAssignments
22 import OptimizationFuel
30 import qualified Data.Map as Map
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')
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.
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
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) =
87 -- Why bother doing these early: dualLivenessWithInsertion,
88 -- insertLateReloads, rewriteAssignments?
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
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
101 ----------- Spills and reloads -------------------
102 g <- run $ dualLivenessWithInsertion procPoints g
103 dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
105 ----------- Sink and inline assignments -------------------
106 g <- runOptimization $ rewriteAssignments g
107 dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
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
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
119 dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
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 ()
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...
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
139 mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
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 ()
146 gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
147 mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
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
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)
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)