Commit 643eb066 authored by Simon Marlow's avatar Simon Marlow

Remove the old stack layout algorithms

Also, do removeDeadAssignments instead of cmmLiveness before stack
allocation, because the former also does liveness analysis, and we can
do just one liveness analysis instead of two.  The stack layout
algorithm doesn't introduce any dead assignments, so this doesn't
affect the generated code.
parent 2c4b427c
...@@ -37,7 +37,6 @@ import Bitmap ...@@ -37,7 +37,6 @@ import Bitmap
import CLabel import CLabel
import Cmm import Cmm
import CmmUtils import CmmUtils
import CmmStackLayout
import Module import Module
import FastString import FastString
import ForeignCall import ForeignCall
......
...@@ -107,10 +107,10 @@ instance Outputable StackMap where ...@@ -107,10 +107,10 @@ instance Outputable StackMap where
cmmLayoutStack :: ProcPointSet -> ByteOff -> CmmGraph cmmLayoutStack :: ProcPointSet -> ByteOff -> CmmGraph
-> FuelUniqSM (CmmGraph, BlockEnv StackMap) -> FuelUniqSM (CmmGraph, BlockEnv StackMap)
cmmLayoutStack procpoints entry_args cmmLayoutStack procpoints entry_args
graph@(CmmGraph { g_entry = entry }) graph0@(CmmGraph { g_entry = entry })
= do = do
pprTrace "cmmLayoutStack" (ppr entry_args) $ return () pprTrace "cmmLayoutStack" (ppr entry_args) $ return ()
liveness <- cmmLiveness graph (graph, liveness) <- removeDeadAssignments graph0
pprTrace "liveness" (ppr liveness) $ return () pprTrace "liveness" (ppr liveness) $ return ()
let blocks = postorderDfs graph let blocks = postorderDfs graph
......
...@@ -48,7 +48,8 @@ cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness ...@@ -48,7 +48,8 @@ cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness
cmmLiveness graph = cmmLiveness graph =
liftM check $ dataflowAnalBwd graph [] $ analBwd liveLattice xferLive liftM check $ dataflowAnalBwd graph [] $ analBwd liveLattice xferLive
where entry = g_entry graph where entry = g_entry graph
check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts check facts = noLiveOnEntry entry
(expectJust "check" $ mapLookup entry facts) facts
-- | On entry to the procedure, there had better not be any LocalReg's live-in. -- | On entry to the procedure, there had better not be any LocalReg's live-in.
noLiveOnEntry :: BlockId -> CmmLive -> a -> a noLiveOnEntry :: BlockId -> CmmLive -> a -> a
...@@ -63,13 +64,11 @@ gen a live = foldRegsUsed extendRegSet live a ...@@ -63,13 +64,11 @@ gen a live = foldRegsUsed extendRegSet live a
kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
kill a live = foldRegsDefd deleteFromRegSet live a kill a live = foldRegsDefd deleteFromRegSet live a
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a)
=> a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a gen_kill a = gen a . kill a
-- | The transfer function -- | The transfer function
-- EZY: Bits of this analysis are duplicated in CmmSpillReload, though
-- it's not really easy to efficiently reuse all of this. Keep in mind
-- if you need to update this analysis.
xferLive :: BwdTransfer CmmNode CmmLive xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst xferLive = mkBTransfer3 fst mid lst
where fst _ f = f where fst _ f = f
...@@ -82,18 +81,23 @@ xferLive = mkBTransfer3 fst mid lst ...@@ -82,18 +81,23 @@ xferLive = mkBTransfer3 fst mid lst
-- Removing assignments to dead variables -- Removing assignments to dead variables
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
removeDeadAssignments :: CmmGraph -> FuelUniqSM CmmGraph removeDeadAssignments :: CmmGraph -> FuelUniqSM (CmmGraph, BlockEnv CmmLive)
removeDeadAssignments g = removeDeadAssignments g =
liftM fst $ dataflowPassBwd g [] $ analRewBwd liveLattice xferLive rewrites dataflowPassBwd g [] $ analRewBwd liveLattice xferLive rewrites
where rewrites = mkBRewrite3 nothing middle nothing where rewrites = mkBRewrite3 nothing middle nothing
-- SDM: no need for deepBwdRw here, we only rewrite to empty -- SDM: no need for deepBwdRw here, we only rewrite to empty
-- Beware: deepBwdRw with one polymorphic function seems more reasonable here, -- Beware: deepBwdRw with one polymorphic function seems more
-- but GHC panics while compiling, see bug #4045. -- reasonable here, but GHC panics while compiling, see bug
-- #4045.
middle :: CmmNode O O -> Fact O CmmLive -> CmmReplGraph O O middle :: CmmNode O O -> Fact O CmmLive -> CmmReplGraph O O
middle (CmmAssign (CmmLocal reg') _) live | not (reg' `elemRegSet` live) = return $ Just emptyGraph middle (CmmAssign (CmmLocal reg') _) live
| not (reg' `elemRegSet` live)
= return $ Just emptyGraph
-- XXX maybe this should be somewhere else... -- XXX maybe this should be somewhere else...
middle (CmmAssign lhs (CmmReg rhs)) _ | lhs == rhs = return $ Just emptyGraph middle (CmmAssign lhs (CmmReg rhs)) _ | lhs == rhs
middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs = return $ Just emptyGraph = return $ Just emptyGraph
middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs
= return $ Just emptyGraph
middle _ _ = return Nothing middle _ _ = return Nothing
nothing :: CmmNode e x -> Fact x CmmLive -> CmmReplGraph e x nothing :: CmmNode e x -> Fact x CmmLive -> CmmReplGraph e x
......
...@@ -16,12 +16,12 @@ import CmmLive ...@@ -16,12 +16,12 @@ import CmmLive
import CmmBuildInfoTables import CmmBuildInfoTables
import CmmCommonBlockElim import CmmCommonBlockElim
import CmmProcPoint import CmmProcPoint
import CmmSpillReload
import CmmRewriteAssignments import CmmRewriteAssignments
import CmmStackLayout
import CmmContFlowOpt import CmmContFlowOpt
import OptimizationFuel import OptimizationFuel
import CmmLayoutStack import CmmLayoutStack
import Hoopl
import CmmUtils
import DynFlags import DynFlags
import ErrUtils import ErrUtils
...@@ -95,9 +95,6 @@ cpsTop :: HscEnv -> CmmDecl -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmDecl)]) ...@@ -95,9 +95,6 @@ cpsTop :: HscEnv -> CmmDecl -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmDecl)])
cpsTop _ p@(CmmData {}) = return ([], [(Set.empty, p)]) cpsTop _ p@(CmmData {}) = return ([], [(Set.empty, p)])
cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) = cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) =
do do
-- Why bother doing these early: dualLivenessWithInsertion,
-- insertLateReloads, rewriteAssignments?
----------- Control-flow optimisations --------------- ----------- Control-flow optimisations ---------------
g <- {-# SCC "cmmCfgOpts(1)" #-} return $ cmmCfgOpts g g <- {-# SCC "cmmCfgOpts(1)" #-} return $ cmmCfgOpts g
dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations" g dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations" g
...@@ -110,63 +107,33 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) ...@@ -110,63 +107,33 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
----------- Proc points ------------------- ----------- Proc points -------------------
let callPPs = {-# SCC "callProcPoints" #-} callProcPoints g let callPPs = {-# SCC "callProcPoints" #-} callProcPoints g
procPoints <- {-# SCC "minimalProcPointSet" #-} run $ minimalProcPointSet (targetPlatform dflags) callPPs g procPoints <- {-# SCC "minimalProcPointSet" #-} run $
minimalProcPointSet (targetPlatform dflags) callPPs g
----------- Layout the stack and manifest Sp ---------------
-- (also does: removeDeadAssignments, and lowerSafeForeignCalls)
(g, stackmaps) <- {-# SCC "layoutStack" #-} (g, stackmaps) <- {-# SCC "layoutStack" #-}
run $ cmmLayoutStack procPoints entry_off g run $ cmmLayoutStack procPoints entry_off g
dump Opt_D_dump_cmmz_sp "Layout Stack" g dump Opt_D_dump_cmmz_sp "Layout Stack" g
-- g <- {-# SCC "addProcPointProtocols" #-} run $ addProcPointProtocols callPPs procPoints g
-- dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
--
-- ----------- Spills and reloads -------------------
-- g <- {-# SCC "dualLivenessWithInsertion" #-} run $ dualLivenessWithInsertion procPoints g
-- dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
--
-- ----------- Sink and inline assignments ------------------- -- ----------- Sink and inline assignments -------------------
-- g <- {-# SCC "rewriteAssignments" #-} runOptimization $ rewriteAssignments platform g -- g <- {-# SCC "rewriteAssignments" #-} runOptimization $
-- rewriteAssignments platform g
-- dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g -- dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
--
----------- Eliminate dead assignments -------------------
g <- {-# SCC "removeDeadAssignments" #-} runOptimization $ removeDeadAssignments g
dump Opt_D_dump_cmmz_dead "Post remove dead assignments" g
-- ----------- Zero dead stack slots (Debug only) ---------------
-- -- Debugging: stubbing slots on death can cause crashes early
-- g <- if opt_StubDeadValues
-- then {-# SCC "stubSlotsOnDeath" #-} run $ stubSlotsOnDeath g
-- else return g
-- dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
--
-- --------------- Stack layout ----------------
-- slotEnv <- {-# SCC "liveSlotAnal" #-} run $ liveSlotAnal g
-- let spEntryMap = getSpEntryMap entry_off g
-- mbpprTrace "live slot analysis results: " (ppr slotEnv) $ return ()
-- let areaMap = {-# SCC "layout" #-} layout procPoints spEntryMap slotEnv entry_off g
-- mbpprTrace "areaMap" (ppr areaMap) $ return ()
--
-- ------------ Manifest the stack pointer --------
-- g <- {-# SCC "manifestSP" #-} run $ manifestSP spEntryMap areaMap entry_off 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 ------------ ------------- Split into separate procedures ------------
procPointMap <- {-# SCC "procPointAnalysis" #-} run $ procPointAnalysis procPoints g procPointMap <- {-# SCC "procPointAnalysis" #-} run $
procPointAnalysis procPoints g
dumpWith dflags ppr Opt_D_dump_cmmz_procmap "procpoint map" procPointMap dumpWith dflags ppr Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
gs <- {-# SCC "splitAtProcPoints" #-} run $ splitAtProcPoints l callPPs procPoints procPointMap gs <- {-# SCC "splitAtProcPoints" #-} run $
(CmmProc h l g) splitAtProcPoints l callPPs procPoints procPointMap (CmmProc h l g)
dumps Opt_D_dump_cmmz_split "Post splitting" gs dumps Opt_D_dump_cmmz_split "Post splitting" gs
------------- More CAFs and foreign calls ------------ ------------- More CAFs ------------------------------
cafEnv <- {-# SCC "cafAnal" #-} run $ cafAnal platform g cafEnv <- {-# SCC "cafAnal" #-} run $ cafAnal platform g
let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs
mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return () mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return ()
-- gs <- {-# SCC "lowerSafeForeignCalls" #-} run $ mapM (lowerSafeForeignCalls areaMap) gs
-- dumps Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls" gs
-- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
gs <- {-# SCC "setInfoTableStackMap" #-} gs <- {-# SCC "setInfoTableStackMap" #-}
return $ map (setInfoTableStackMap stackmaps) gs return $ map (setInfoTableStackMap stackmaps) gs
......
...@@ -403,11 +403,12 @@ splitAtProcPoints entry_label callPPs procPoints procMap ...@@ -403,11 +403,12 @@ splitAtProcPoints entry_label callPPs procPoints procMap
[] -> graphEnv [] -> graphEnv
[id] -> add graphEnv id bid b [id] -> add graphEnv id bid b
_ -> panic "Each block should be reachable from only one ProcPoint" _ -> panic "Each block should be reachable from only one ProcPoint"
Nothing -> pprPanic "block not reached by a proc point?" (ppr bid) Nothing -> graphEnv
where bid = entryLabel b where bid = entryLabel b
add graphEnv procId bid b = mapInsert procId graph' graphEnv add graphEnv procId bid b = mapInsert procId graph' graphEnv
where graph = mapLookup procId graphEnv `orElse` mapEmpty where graph = mapLookup procId graphEnv `orElse` mapEmpty
graph' = mapInsert bid b graph graph' = mapInsert bid b graph
graphEnv <- return $ foldGraphBlocks addBlock emptyBlockMap g graphEnv <- return $ foldGraphBlocks addBlock emptyBlockMap g
-- Build a map from proc point BlockId to pairs of: -- Build a map from proc point BlockId to pairs of:
-- * Labels for their new procedures -- * Labels for their new procedures
......
{-# LANGUAGE GADTs, NoMonoLocalBinds, FlexibleContexts #-}
-- Norman likes local bindings
-- If this module lives on I'd like to get rid of this flag in due course
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- TODO: Get rid of this flag:
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module CmmSpillReload
( dualLivenessWithInsertion
)
where
import Outputable
dualLivenessWithInsertion = panic "BANG BANG BANG BANG BANG BANG CLICK CLICK"
{-
import BlockId
import Cmm
import CmmUtils
import CmmLive
import OptimizationFuel
import Control.Monad
import Outputable hiding (empty)
import qualified Outputable as PP
import UniqSet
import Hoopl
import Data.Maybe
import Prelude hiding (succ, zip)
{- Note [Overview of spill/reload]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The point of this module is to insert spills and reloads to establish
the invariant that at a call or any proc point with an established
protocol all live variables not expected in registers are sitting on the
stack. We use a backward dual liveness analysis (both traditional
register liveness as well as register slot liveness on the stack) to
insert spills and reloads. It should be followed by a forward
transformation to sink reloads as deeply as possible, so as to reduce
register pressure: this transformation is performed by
CmmRewriteAssignments.
A variable can be expected to be live in a register, live on the
stack, or both. This analysis ensures that spills and reloads are
inserted as needed to make sure that every live variable needed
after a call is available on the stack. Spills are placed immediately
after their reaching definitions, but reloads are placed immediately
after a return from a call (the entry point.)
Note that we offer no guarantees about the consistency of the value
in memory and the value in the register, except that they are
equal across calls/procpoints. If the variable is changed, this
mapping breaks: but as the original value of the register may still
be useful in a different context, the memory location is not updated.
-}
data DualLive = DualLive { on_stack :: RegSet, in_regs :: RegSet }
changeStack, changeRegs :: (RegSet -> RegSet) -> DualLive -> DualLive
changeStack f live = live { on_stack = f (on_stack live) }
changeRegs f live = live { in_regs = f (in_regs live) }
dualLiveLattice :: DataflowLattice DualLive
dualLiveLattice = DataflowLattice "variables live in registers and on stack" empty add
where empty = DualLive emptyRegSet emptyRegSet
add _ (OldFact old) (NewFact new) = (changeIf $ change1 || change2, DualLive stack regs)
where (change1, stack) = add1 (on_stack old) (on_stack new)
(change2, regs) = add1 (in_regs old) (in_regs new)
add1 old new = if sizeRegSet join > sizeRegSet old then (True, join) else (False, old)
where join = plusRegSet old new
dualLivenessWithInsertion :: BlockSet -> CmmGraph -> FuelUniqSM CmmGraph
dualLivenessWithInsertion procPoints g =
liftM fst $ dataflowPassBwd g [] $ analRewBwd dualLiveLattice
(dualLiveTransfers (g_entry g) procPoints)
(insertSpillsAndReloads g procPoints)
-- Note [Live registers on entry to procpoints]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Remember that the transfer function is only ever run on the rewritten
-- version of a graph, and the rewrite function for spills and reloads
-- enforces the invariant that no local registers are live on entry to
-- a procpoint. Accordingly, we check for this invariant here. An old
-- version of this code incorrectly claimed that any live registers were
-- live on the stack before entering the function: this is wrong, but
-- didn't cause bugs because it never actually was invoked.
dualLiveTransfers :: BlockId -> BlockSet -> (BwdTransfer CmmNode DualLive)
dualLiveTransfers entry procPoints = mkBTransfer3 first middle last
where first :: CmmNode C O -> DualLive -> DualLive
first (CmmEntry id) live -- See Note [Live registers on entry to procpoints]
| id == entry || setMember id procPoints = noLiveOnEntry id (in_regs live) live
| otherwise = live
middle :: CmmNode O O -> DualLive -> DualLive
middle m = changeStack updSlots
. changeRegs updRegs
where -- Reuse middle of liveness analysis from CmmLive
updRegs = case getBTransfer3 xferLive of (_, middle, _) -> middle m
updSlots live = foldSlotsUsed reload (foldSlotsDefd spill live m) m
spill live s@(RegSlot r, _, _) = check s $ deleteFromRegSet live r
spill live _ = live
reload live s@(RegSlot r, _, _) = check s $ extendRegSet live r
reload live _ = live
-- Ensure the assignment refers to the entirety of the
-- register slot (and not just a slice).
check (RegSlot (LocalReg _ ty), o, w) x
| o == w && w == widthInBytes (typeWidth ty) = x
check _ _ = panic "dualLiveTransfers: slices unsupported"
-- Register analysis is identical to liveness analysis from CmmLive.
last :: CmmNode O C -> FactBase DualLive -> DualLive
last l fb = changeRegs (gen_kill l) $ case l of
CmmCall {cml_cont=Nothing} -> empty
CmmCall {cml_cont=Just k} -> keep_stack_only k
CmmForeignCall {succ=k} -> keep_stack_only k
_ -> joinOutFacts dualLiveLattice l fb
where empty = fact_bot dualLiveLattice
lkp k = fromMaybe empty (lookupFact k fb)
keep_stack_only k = DualLive (on_stack (lkp k)) emptyRegSet
insertSpillsAndReloads :: CmmGraph -> BlockSet -> CmmBwdRewrite DualLive
insertSpillsAndReloads graph procPoints = mkBRewrite3 first middle nothing
-- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
-- but GHC miscompiles it, see bug #4044.
where first :: CmmNode C O -> Fact O DualLive -> CmmReplGraph C O
first e@(CmmEntry id) live =
if id /= (g_entry graph) && setMember id procPoints then
case map reload (regSetToList (in_regs live)) of
[] -> return Nothing
is -> return $ Just $ mkFirst e <*> mkMiddles is
else return Nothing
-- EZY: There was some dead code for handling the case where
-- we were not splitting procedures. Check Git history if
-- you're interested (circa e26ea0f41).
middle :: CmmNode O O -> Fact O DualLive -> CmmReplGraph O O
-- Don't add spills next to reloads.
middle (CmmAssign (CmmLocal reg) (CmmLoad (CmmStackSlot (RegSlot reg') _) _)) _ | reg == reg' = return Nothing
-- Spill if register is live on stack.
middle m@(CmmAssign (CmmLocal reg) _) live
| reg `elemRegSet` on_stack live = return (Just (mkMiddles [m, spill reg]))
middle _ _ = return Nothing
nothing _ _ = return Nothing
spill, reload :: LocalReg -> CmmNode O O
spill r = CmmStore (regSlot r) (CmmReg $ CmmLocal r)
reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
---------------------
-- prettyprinting
ppr_regs :: String -> RegSet -> SDoc
ppr_regs s regs = text s <+> commafy (map ppr $ regSetToList regs)
where commafy xs = hsep $ punctuate comma xs
instance Outputable DualLive where
ppr (DualLive {in_regs = regs, on_stack = stack}) =
if nullRegSet regs && nullRegSet stack then
text "<nothing-live>"
else
nest 2 $ fsep [if nullRegSet regs then PP.empty
else (ppr_regs "live in regs =" regs),
if nullRegSet stack then PP.empty
else (ppr_regs "live on stack =" stack)]
-}
This diff is collapsed.
...@@ -201,9 +201,7 @@ Library ...@@ -201,9 +201,7 @@ Library
CmmOpt CmmOpt
CmmParse CmmParse
CmmProcPoint CmmProcPoint
CmmSpillReload
CmmRewriteAssignments CmmRewriteAssignments
CmmStackLayout
CmmType CmmType
CmmUtils CmmUtils
CmmLayoutStack CmmLayoutStack
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment