From ced4c754ae05fcd3fb7afb0ca3218517011f231c Mon Sep 17 00:00:00 2001
From: "dias@cs.tufts.edu" <unknown>
Date: Fri, 18 Sep 2009 19:16:26 +0000
Subject: [PATCH] More sensible use of -fnew-codegen and less debugging output

---
 compiler/cmm/CmmBuildInfoTables.hs |    9 ++++++---
 compiler/cmm/CmmCPSZ.hs            |   23 ++++++++++-------------
 compiler/cmm/CmmSpillReload.hs     |    2 +-
 compiler/cmm/ZipDataflow.hs        |    4 ++--
 compiler/main/HscMain.lhs          |    7 ++-----
 5 files changed, 21 insertions(+), 24 deletions(-)

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index c2be8c9..caa13c5 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -79,9 +79,12 @@ import ZipDataflow
 -- which may differ depending on whether there is an update frame.
 live_ptrs :: ByteOff -> BlockEnv SubAreaSet -> AreaMap -> BlockId -> [Maybe LocalReg]
 live_ptrs oldByte slotEnv areaMap bid =
-  -- pprTrace "live_ptrs for" (ppr bid <+> ppr youngByte <+> ppr liveSlots) $
-  reverse $ slotsToList youngByte liveSlots []
-  where slotsToList n [] results | n == oldByte = results -- at old end of stack frame
+  -- pprTrace "live_ptrs for" (ppr bid <+> text (show oldByte ++ "-" ++ show youngByte) <+>
+  --                           ppr liveSlots) $
+  -- pprTrace ("stack layout for " ++ show bid ++ ": ") (ppr res) $ res
+  res
+  where res = reverse $ slotsToList youngByte liveSlots []
+        slotsToList n [] results | n == oldByte = results -- at old end of stack frame
         slotsToList n (s : _) _  | n == oldByte =
           pprPanic "slot left off live_ptrs" (ppr s <+> ppr oldByte <+>
                ppr n <+> ppr liveSlots <+> ppr youngByte)
diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs
index f2e245f..8bcadbb 100644
--- a/compiler/cmm/CmmCPSZ.hs
+++ b/compiler/cmm/CmmCPSZ.hs
@@ -46,19 +46,16 @@ protoCmmCPSZ :: HscEnv -- Compilation env including
              -> (TopSRT, [CmmZ])  -- SRT table and accumulating list of compiled procs
              -> CmmZ              -- Input C-- with Procedures
              -> IO (TopSRT, [CmmZ]) -- Output CPS transformed C--
-protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops)
-  | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
-  = return (topSRT, Cmm tops : rst)                -- Only if -fnew-codegen
-  | otherwise
-  = do	let dflags = hsc_dflags hsc_env
-        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
-        -- (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops 
-        let cmms = Cmm (reverse (concat tops))
-        dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
-        return (topSRT, cmms : rst)
+protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops) =
+  do let dflags = hsc_dflags hsc_env
+     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
+     -- (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops 
+     let cmms = Cmm (reverse (concat tops))
+     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
+     return (topSRT, cmms : rst)
 
 {- [Note global fuel]
 ~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index c452525..1cdafa9 100644
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -64,7 +64,7 @@ changeRegs  f live = live { in_regs  = f (in_regs  live) }
 
 dualLiveLattice :: DataflowLattice DualLive
 dualLiveLattice =
-      DataflowLattice "variables live in registers and on stack" empty add True
+      DataflowLattice "variables live in registers and on stack" empty add False
     where empty = DualLive emptyRegSet emptyRegSet
           -- | compute in the Tx monad to track whether anything has changed
           add new old = do stack <- add1 (on_stack new) (on_stack old)
diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs
index 92fc375..ba8e75a 100644
--- a/compiler/cmm/ZipDataflow.hs
+++ b/compiler/cmm/ZipDataflow.hs
@@ -570,7 +570,7 @@ mk_set_or_save :: (DataflowAnalysis df, Monad (df a), Outputable a) =>
                   (BlockId -> Bool) -> LastOutFacts a -> df a ()
 mk_set_or_save is_local (LastOutFacts l) = mapM_ set_or_save_one l
     where set_or_save_one (id, a) =
-              if is_local id then setFact id a else pprTrace "addLastOutFact" (ppr $ length l) $ addLastOutFact (id, a)
+              if is_local id then setFact id a else addLastOutFact (id, a)
 
 
 
@@ -980,7 +980,7 @@ instance FixedPoint ForwardFixedPoint where
 
 
 dump_things :: Bool
-dump_things = True
+dump_things = False
 
 my_trace :: String -> SDoc -> a -> a
 my_trace = if dump_things then pprTrace else \_ _ a -> a
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 1f32c35..e0d81b7 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -789,11 +789,8 @@ tryNewCodeGen	:: HscEnv -> Module -> [TyCon] -> [Module]
 		-> HpcInfo
 		-> IO [Cmm]
 tryNewCodeGen hsc_env this_mod data_tycons imported_mods 
-	      cost_centre_info stg_binds hpc_info
-  | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
-  = return []
-  | otherwise
-  = 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 imported_mods 
 		 	 cost_centre_info stg_binds hpc_info
 	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen" 
-- 
1.7.10.4