-- If this module lives on I'd like to get rid of this flag in due course
module CmmCPS (
- -- | Converts C-- with full proceedures and parameters
- -- to a CPS transformed C-- with the stack made manifest.
- -- Well, sort of.
- protoCmmCPS
+ -- | 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
) where
import CLabel
import CmmProcPoint
import CmmSpillReload
import CmmStackLayout
+import CmmContFlowOpt
import OptimizationFuel
import DynFlags
import StaticFlags
-----------------------------------------------------------------------------
--- |Top level driver for the CPS pass
+-- | Top level driver for C-- pipeline
-----------------------------------------------------------------------------
-- There are two complications here:
-- 1. We need to compile the procedures in two stages because we need
-- 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.
-protoCmmCPS :: HscEnv -- Compilation env including
+-- 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
-- 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--
-protoCmmCPS hsc_env (topSRT, rst) (Cmm tops) =
+cmmPipeline hsc_env (topSRT, rst) prog =
do let dflags = hsc_dflags hsc_env
+ (Cmm tops) = runCmmContFlowOpts prog
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))
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
- return (topSRT, cmms : rst)
+ -- SRT is not affected by control flow optimization pass
+ let prog' = map runCmmContFlowOpts (cmms : rst)
+ return (topSRT, prog')
{- [Note global fuel]
~~~~~~~~~~~~~~~~~~~~~
-------------------- Stuff for new code gen ---------------------
tryNewCodeGen :: HscEnv -> Module -> [TyCon]
- -> CollectedCCs
- -> [(StgBinding,[(Id,[Id])])]
- -> HpcInfo
- -> IO [Cmm]
+ -> CollectedCCs
+ -> [(StgBinding,[(Id,[Id])])]
+ -> HpcInfo
+ -> IO [Cmm]
tryNewCodeGen hsc_env this_mod data_tycons
- cost_centre_info stg_binds hpc_info =
- do { let dflags = hsc_dflags hsc_env
+ cost_centre_info stg_binds hpc_info =
+ do { let dflags = hsc_dflags hsc_env
; prog <- StgCmm.codeGen dflags this_mod data_tycons
- cost_centre_info stg_binds hpc_info
- ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
- (pprCmms prog)
-
- ; prog <- return $ map runCmmContFlowOpts prog
- -- Control flow optimisation
+ cost_centre_info stg_binds hpc_info
+ ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
+ (pprCmms prog)
-- We are building a single SRT for the entire module, so
-- we must thread it through all the procedures as we cps-convert them.
; us <- mkSplitUniqSupply 'S'
- ; let topSRT = initUs_ us emptySRT
- ; (topSRT, prog) <- foldM (protoCmmCPS hsc_env) (topSRT, []) prog
- -- The main CPS conversion
-
- ; prog <- return $ map runCmmContFlowOpts (srtToData topSRT : prog)
- -- Control flow optimisation, again
+ ; let initTopSRT = initUs_ us emptySRT
+ ; (topSRT, prog) <- foldM (cmmPipeline hsc_env) (initTopSRT, []) prog
- ; let prog' = map cmmOfZgraph prog
- ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
- ; return prog' }
+ ; let prog' = map cmmOfZgraph (srtToData topSRT : prog)
+ ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
+ ; return prog' }
optionallyConvertAndOrCPS :: HscEnv -> [Cmm] -> IO [Cmm]
dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (ppr cmm)
--continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
us <- mkSplitUniqSupply 'C'
- let cvtm = runCmmContFlowOpts `liftM` cmmToZgraph cmm
- let zgraph = initUs_ us cvtm
- us <- mkSplitUniqSupply 'S'
- let topSRT = initUs_ us emptySRT
- (_, [cps_zgraph]) <- protoCmmCPS hsc_env (topSRT, []) zgraph
- let chosen_graph = if dopt Opt_RunCPSZ dflags then cps_zgraph else zgraph
+ let zgraph = initUs_ us (cmmToZgraph cmm)
+ chosen_graph <-
+ if dopt Opt_RunCPSZ dflags
+ then do us <- mkSplitUniqSupply 'S'
+ let topSRT = initUs_ us emptySRT
+ (_, [zgraph]) <- cmmPipeline hsc_env (topSRT, []) zgraph
+ return zgraph
+ else return (runCmmContFlowOpts zgraph)
dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (ppr chosen_graph)
showPass dflags "Convert from Z back to Cmm"
- let cvt = cmmOfZgraph $ runCmmContFlowOpts $ chosen_graph
+ let cvt = cmmOfZgraph chosen_graph
dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
return cvt