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 <ezyang@mit.edu>

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index 35eabb3..c29e5f6 100644 (file)
--- 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 (
 -- 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
 ) where
 
 import CLabel

@@ -17,6 +17,7 @@ import CmmCommonBlockElim
 import CmmProcPoint
 import CmmSpillReload
 import CmmStackLayout
 import CmmProcPoint
 import CmmSpillReload
 import CmmStackLayout

+import CmmContFlowOpt

 import OptimizationFuel
 
 import DynFlags
 import OptimizationFuel
 
 import DynFlags

@@ -30,7 +31,7 @@ import Outputable
 import StaticFlags
 
 -----------------------------------------------------------------------------
 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
 -----------------------------------------------------------------------------
 -- 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.
 -- 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--
                        -- 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
   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)
      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]
 ~~~~~~~~~~~~~~~~~~~~~
 
 {- [Note global fuel]
 ~~~~~~~~~~~~~~~~~~~~~

diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes
index 546f9ae..5f26edd 100644 (file)
--- a/compiler/cmm/cmm-notes
+++ b/compiler/cmm/cmm-notes
@@ -8,8 +8,7 @@ More notes (June 11)
 \r
   or parameterise FCode over its envt; the CgState part seem useful for both\r
 \r
 \r
   or parameterise FCode over its envt; the CgState part seem useful for both\r
 \r

-* Move top and tail calls to runCmmContFlowOpts from HscMain to CmmCps.cpsTop\r
-  (and rename the latter!)\r
+* Rename CmmCPS\r

 \r
 * "Remove redundant reloads" in CmmSpillReload should be redundant; since\r
   insertLateReloads is now gone, every reload is reloading a live variable.\r
 \r
 * "Remove redundant reloads" in CmmSpillReload should be redundant; since\r
   insertLateReloads is now gone, every reload is reloading a live variable.\r

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 6542a06..217a0c4 100644 (file)
--- 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]
 -------------------- 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
 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
         ; 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'
 
         -- 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]
 
 
 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'
        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"
        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
 
        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
        return cvt