-- 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)
-> (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]
~~~~~~~~~~~~~~~~~~~~~
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)
(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)
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
-> 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"