Commit c8e5f0f6 authored by Edward Z. Yang's avatar Edward Z. Yang

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's avatarEdward Z. Yang <>
parent f13f9fca
......@@ -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.
-- | 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.
) 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]
......@@ -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.
......@@ -979,20 +979,13 @@ tryNewCodeGen hsc_env this_mod data_tycons
; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
(pprCmms prog)
; prog <- return $ map runCmmContFlowOpts prog
-- Control flow optimisation
-- 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
; let prog' = map cmmOfZgraph (srtToData topSRT : prog)
; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
; return prog' }
......@@ -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 zgraph = initUs_ us (cmmToZgraph cmm)
chosen_graph <-
if dopt Opt_RunCPSZ dflags
then do 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
(_, [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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment