6 , middleLiveness, 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 (flip const) mid last
51 mid m = gen_kill m . midLive m
52 last l = gen_kill l . lastLive l
54 noLiveOnEntry entry (expectJust "check" $ lookupBlockEnv facts entry) facts
56 gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
57 gen_kill a = gen a . kill a
59 middleLiveness :: Middle -> CmmLive -> CmmLive
60 middleLiveness = gen_kill
62 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
63 noLiveOnEntry :: BlockId -> CmmLive -> a -> a
64 noLiveOnEntry bid in_fact x =
65 if isEmptyUniqSet in_fact then x
66 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
68 -- | The transfer equations use the traditional 'gen' and 'kill'
69 -- notations, which should be familiar from the dragon book.
70 gen :: UserOfLocalRegs a => a -> RegSet -> RegSet
71 gen a live = foldRegsUsed extendRegSet live a
72 kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
73 kill a live = foldRegsDefd delOneFromUniqSet live a
75 midLive :: Middle -> CmmLive -> CmmLive
76 midLive (MidForeignCall {}) _ = emptyUniqSet
79 lastLive :: Last -> (BlockId -> CmmLive) -> CmmLive
80 lastLive l env = last l
81 where last (LastBranch id) = env id
82 last (LastCall _ _ _ _ _) = emptyUniqSet
83 last (LastCondBranch _ t f) = unionUniqSets (env t) (env f)
84 last (LastSwitch _ tbl) = unionManyUniqSets $ map env (catMaybes tbl)