6 , middleLiveness, lastLiveness, noLiveOnEntry
25 -----------------------------------------------------------------------------
26 -- Calculating what variables are live on entry to a basic block
27 -----------------------------------------------------------------------------
29 -- | The variables live on entry to a block
32 -- | The dataflow lattice
33 liveLattice :: DataflowLattice CmmLive
34 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
36 let join = unionUniqSets new old in
37 (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
39 -- | A mapping from block labels to the variables live on entry
40 type BlockEntryLiveness = BlockEnv CmmLive
42 -----------------------------------------------------------------------------
43 -- | Calculated liveness info for a CmmGraph
44 -----------------------------------------------------------------------------
45 cmmLivenessZ :: CmmGraph -> FuelMonad BlockEntryLiveness
46 cmmLivenessZ g@(LGraph entry _ _) =
47 liftM (check . zdfFpFacts) (res :: FuelMonad (CmmBackwardFixedPoint CmmLive))
48 where res = zdfSolveFrom emptyBlockEnv "liveness analysis" liveLattice transfers
49 emptyUniqSet (graphOfLGraph g)
50 transfers = BackwardTransfers first middle last
52 middle = flip middleLiveness
53 last = flip lastLiveness
55 noLiveOnEntry entry (expectJust "check" $ lookupBlockEnv facts entry) facts
57 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
58 noLiveOnEntry :: BlockId -> CmmLive -> a -> a
59 noLiveOnEntry bid in_fact x =
60 if isEmptyUniqSet in_fact then x
61 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
63 -- | The transfer equations use the traditional 'gen' and 'kill'
64 -- notations, which should be familiar from the dragon book.
65 gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
66 gen a live = foldRegsUsed extendRegSet live a
67 kill a live = foldRegsUsed delOneFromUniqSet live a
69 -- Why aren't these function using the typeclasses on Middle and Last?
70 middleLiveness :: Middle -> CmmLive -> CmmLive
71 middleLiveness (MidComment {}) live = live
72 middleLiveness (MidAssign lhs expr) live = gen expr $ kill lhs live
73 middleLiveness (MidStore addr rval) live = gen addr $ gen rval live
74 middleLiveness (MidForeignCall _ tgt _ args) _ = gen tgt $ gen args emptyUniqSet
76 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
77 lastLiveness l env = last l
78 where last (LastBranch id) = env id
79 last (LastCall tgt Nothing _ _) = gen tgt $ emptyUniqSet
80 last (LastCall tgt (Just k) _ _) = gen tgt $ env k
81 last (LastCondBranch e t f) = gen e $ unionUniqSets (env t) (env f)
82 last (LastSwitch e tbl) =
83 gen e $ unionManyUniqSets $ map env (catMaybes tbl)