From: Edward Z. Yang Date: Tue, 14 Jun 2011 11:29:38 +0000 (+0100) Subject: Move control flow optimization to CmmCPS. X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=c8e5f0f65223013cd21f25512b21eac0327aefdf Move control flow optimization to CmmCPS. Unfortunately, I couldn't remove all incidences of runCmmContFlowOpt from HscMain; in particular, there is a Cmm conversion testing facility which may run with only control flow optimizations, which I preserved the semantics of. Given the state of the current codegen, this code might be moribund anyway. Signed-off-by: Edward Z. Yang --- diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs index 35eabb3..c29e5f6 100644 --- a/compiler/cmm/CmmCPS.hs +++ b/compiler/cmm/CmmCPS.hs @@ -3,10 +3,10 @@ -- 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 @@ -17,6 +17,7 @@ import CmmCommonBlockElim import CmmProcPoint import CmmSpillReload import CmmStackLayout +import CmmContFlowOpt import OptimizationFuel import DynFlags @@ -30,7 +31,7 @@ import Outputable 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 @@ -45,20 +46,27 @@ import StaticFlags -- 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] ~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes index 546f9ae..5f26edd 100644 --- a/compiler/cmm/cmm-notes +++ b/compiler/cmm/cmm-notes @@ -8,8 +8,7 @@ More notes (June 11) or parameterise FCode over its envt; the CgState part seem useful for both -* Move top and tail calls to runCmmContFlowOpts from HscMain to CmmCps.cpsTop - (and rename the latter!) +* Rename CmmCPS * "Remove redundant reloads" in CmmSpillReload should be redundant; since insertLateReloads is now gone, every reload is reloading a live variable. diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 6542a06..217a0c4 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -967,34 +967,27 @@ hscCompileCmmFile hsc_env filename -------------------- 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] @@ -1014,15 +1007,17 @@ testCmmConversion hsc_env 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