Split -ddump-cmmz into many smaller flags.

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>

2 files changed, 70 insertions, 45 deletions

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index e2bbbdd9a6..35eabb3317 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -67,48 +67,47 @@ mutable reference cells in an 'HscEnv' and are
 global to one compiler session.
 -}
 
+-- EZY: It might be helpful to have an easy way of dumping the "pre"
+-- input for any given phase, besides just turning it all on with
+-- -ddump-cmmz
+
 cpsTop :: HscEnv -> CmmTop -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmTop)])
 cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
 cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
     do
-       -- Why bother doing it this early?
-       -- g <- dual_rewrite run Opt_D_dump_cmmz "spills and reloads"
-       --                       (dualLivenessWithInsertion callPPs) g
-       -- g <- run $ insertLateReloads g -- Duplicate reloads just before uses
-       -- g <- dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment Elimination"
-       --                   (removeDeadAssignmentsAndReloads callPPs) g
-       dump Opt_D_dump_cmmz "Pre common block elimination" g
-       g <- return $ elimCommonBlocks g
-       dump Opt_D_dump_cmmz "Post common block elimination" g
+       -- Why bother doing these early: dualLivenessWithInsertion,
+       -- insertLateReloads, rewriteAssignments?
 
+       ----------- Eliminate common blocks -------------------
+       g <- return $ elimCommonBlocks g
+       dump Opt_D_dump_cmmz_cbe "Post common block elimination" g
        -- Any work storing block Labels must be performed _after_ elimCommonBlocks
 
        ----------- Proc points -------------------
        let callPPs = callProcPoints g
        procPoints <- run $ minimalProcPointSet callPPs g
        g <- run $ addProcPointProtocols callPPs procPoints g
-       dump Opt_D_dump_cmmz "Post Proc Points Added" g
+       dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
 
        ----------- Spills and reloads -------------------
-       g     <- 
-              -- pprTrace "pre Spills" (ppr g) $
-                dual_rewrite run Opt_D_dump_cmmz "spills and reloads"
-                             (dualLivenessWithInsertion procPoints) g
-                    -- Insert spills at defns; reloads at return points
-       g     <-
-                runOptimization $ rewriteAssignments g
-       dump Opt_D_dump_cmmz "Post rewrite assignments" g
-       g     <-
-               -- pprTrace "post insertLateReloads" (ppr g) $
-                dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment Elimination"
-                                        (removeDeadAssignmentsAndReloads procPoints) g
-                    -- Remove redundant reloads (and any other redundant asst)
-
-       ----------- Debug only: add code to put zero in dead stack slots----
-       -- Debugging: stubbing slots on death can cause crashes early
-       g <- -- trace "post dead-assign elim" $
-            if opt_StubDeadValues then run $ stubSlotsOnDeath g else return g
+       g <- run $ dualLivenessWithInsertion procPoints g
+       dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
 
+       ----------- Sink and inline assignments -------------------
+       g <- runOptimization $ rewriteAssignments g
+       dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
+
+       ----------- Eliminate dead assignments -------------------
+       -- Remove redundant reloads (and any other redundant asst)
+       g <- runOptimization $ removeDeadAssignmentsAndReloads procPoints g
+       dump Opt_D_dump_cmmz_dead "Post Dead Assignment Elimination" g
+
+       ----------- Zero dead stack slots (Debug only) ---------------
+       -- Debugging: stubbing slots on death can cause crashes early
+       g <- if opt_StubDeadValues
+                then run $ stubSlotsOnDeath g
+                else return g
+       dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
 
        --------------- Stack layout ----------------
        slotEnv <- run $ liveSlotAnal g
@@ -119,16 +118,16 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        ------------  Manifest the stack pointer --------
        g  <- run $ manifestSP spEntryMap areaMap entry_off g
-       dump Opt_D_dump_cmmz "after manifestSP" g
+       dump Opt_D_dump_cmmz_sp "Post manifestSP" g
        -- UGH... manifestSP can require updates to the procPointMap.
        -- We can probably do something quicker here for the update...
 
        ------------- Split into separate procedures ------------
        procPointMap  <- run $ procPointAnalysis procPoints g
-       dump Opt_D_dump_cmmz "procpoint map" procPointMap
+       dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
        gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
                                        (CmmProc h l g)
-       mapM_ (dump Opt_D_dump_cmmz "after splitting") gs
+       mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
 
        ------------- More CAFs and foreign calls ------------
        cafEnv <- run $ cafAnal g
@@ -136,30 +135,29 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
        mbpprTrace "localCAFs" (ppr localCAFs) $ return ()
 
        gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
-       mapM_ (dump Opt_D_dump_cmmz "after lowerSafeForeignCalls") gs
+       mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
 
        -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
-       let gs' = map (setInfoTableStackMap slotEnv areaMap) gs
-       mapM_ (dump Opt_D_dump_cmmz "after setInfoTableStackMap") gs'
-       let gs'' = map (bundleCAFs cafEnv) gs'
-       mapM_ (dump Opt_D_dump_cmmz "after bundleCAFs") gs''
-       return (localCAFs, gs'')
+       gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
+       mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
+       gs <- return $ map (bundleCAFs cafEnv) gs
+       mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
+       return (localCAFs, gs)
   where dflags = hsc_dflags hsc_env
         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
-        dump f txt g = dumpIfSet_dyn dflags f txt (ppr g)
+        dump f txt g = do
+            -- ToDo: No easy way of say "dump all the cmmz, *and* split
+            -- them into files."  Also, -ddump-cmmz doesn't play nicely
+            -- with -ddump-to-file, since the headers get omitted.
+            dumpIfSet_dyn dflags f txt (ppr g)
+            when (not (dopt f dflags)) $
+                dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (ppr g)
         -- Runs a required transformation/analysis
         run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
         -- Runs an optional transformation/analysis (and should
         -- thus be subject to optimization fuel)
         runOptimization = runFuelIO (hsc_OptFuel hsc_env)
 
-        -- pass 'run' or 'runOptimization' for 'r'
-        dual_rewrite r flag txt pass g =
-          do dump flag ("Pre " ++ txt)  g
-             g <- r $ pass g
-             dump flag ("Post " ++ txt) $ g
-             return g
-
 -- This probably belongs in CmmBuildInfoTables?
 -- We're just finishing the job here: once we know what CAFs are defined
 -- in non-static closures, we can build the SRTs.
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 46f2affb76..d6cb85b941 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -122,6 +122,21 @@ data DynFlag
    | Opt_D_dump_raw_cmm
    | Opt_D_dump_cmmz
    | Opt_D_dump_cmmz_pretty
+   -- All of the cmmz subflags (there are a lot!)  Automatically
+   -- enabled if you run -ddump-cmmz
+   | Opt_D_dump_cmmz_cbe
+   | Opt_D_dump_cmmz_proc
+   | Opt_D_dump_cmmz_spills
+   | Opt_D_dump_cmmz_rewrite
+   | Opt_D_dump_cmmz_dead
+   | Opt_D_dump_cmmz_stub
+   | Opt_D_dump_cmmz_sp
+   | Opt_D_dump_cmmz_procmap
+   | Opt_D_dump_cmmz_split
+   | Opt_D_dump_cmmz_lower
+   | Opt_D_dump_cmmz_info
+   | Opt_D_dump_cmmz_cafs
+   -- end cmmz subflags
    | Opt_D_dump_cps_cmm
    | Opt_D_dump_cvt_cmm
    | Opt_D_dump_asm
@@ -1254,6 +1269,18 @@ dynamic_flags = [
   , Flag "ddump-raw-cmm"           (setDumpFlag Opt_D_dump_raw_cmm)
   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
+  , Flag "ddump-cmmz-cbe"          (setDumpFlag Opt_D_dump_cmmz_cbe)
+  , Flag "ddump-cmmz-spills"       (setDumpFlag Opt_D_dump_cmmz_spills)
+  , Flag "ddump-cmmz-proc"         (setDumpFlag Opt_D_dump_cmmz_proc)
+  , Flag "ddump-cmmz-rewrite"      (setDumpFlag Opt_D_dump_cmmz_rewrite)
+  , Flag "ddump-cmmz-dead"         (setDumpFlag Opt_D_dump_cmmz_dead)
+  , Flag "ddump-cmmz-stub"         (setDumpFlag Opt_D_dump_cmmz_stub)
+  , Flag "ddump-cmmz-sp"           (setDumpFlag Opt_D_dump_cmmz_sp)
+  , Flag "ddump-cmmz-procmap"      (setDumpFlag Opt_D_dump_cmmz_procmap)
+  , Flag "ddump-cmmz-split"        (setDumpFlag Opt_D_dump_cmmz_split)
+  , Flag "ddump-cmmz-lower"        (setDumpFlag Opt_D_dump_cmmz_lower)
+  , Flag "ddump-cmmz-info"         (setDumpFlag Opt_D_dump_cmmz_info)
+  , Flag "ddump-cmmz-cafs"         (setDumpFlag Opt_D_dump_cmmz_cafs)
   , Flag "ddump-core-stats"        (setDumpFlag Opt_D_dump_core_stats)
   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)