summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordias@cs.tufts.edu <unknown>2009-09-18 19:16:26 +0000
committerdias@cs.tufts.edu <unknown>2009-09-18 19:16:26 +0000
commitced4c754ae05fcd3fb7afb0ca3218517011f231c (patch)
treed46d32900f4cbfb3af69aca6b2c51ad9e6b95bf5
parentdf5b491ce79b42987363ae96bc98b633cf55cca2 (diff)
downloadhaskell-ced4c754ae05fcd3fb7afb0ca3218517011f231c.tar.gz
More sensible use of -fnew-codegen and less debugging output
-rw-r--r--compiler/cmm/CmmBuildInfoTables.hs9
-rw-r--r--compiler/cmm/CmmCPSZ.hs23
-rw-r--r--compiler/cmm/CmmSpillReload.hs2
-rw-r--r--compiler/cmm/ZipDataflow.hs4
-rw-r--r--compiler/main/HscMain.lhs7
5 files changed, 21 insertions, 24 deletions
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index c2be8c9d11..caa13c5940 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 f2e245fc91..8bcadbb122 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 c452525253..1cdafa9baa 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 92fc375181..ba8e75ac64 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 1f32c353a8..e0d81b76fb 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"