1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
6 , middleLiveness, lastLiveness
21 -----------------------------------------------------------------------------
22 -- Calculating what variables are live on entry to a basic block
23 -----------------------------------------------------------------------------
25 -- | The variables live on entry to a block
28 -- | The dataflow lattice
29 liveLattice :: DataflowLattice CmmLive
30 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
32 let join = unionUniqSets new old in
33 (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
35 -- | A mapping from block labels to the variables live on entry
36 type BlockEntryLiveness = BlockEnv CmmLive
38 -----------------------------------------------------------------------------
39 -- | Calculated liveness info for a CmmGraph
40 -----------------------------------------------------------------------------
41 cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
43 where env = runDFA liveLattice $
44 do run_b_anal transfer g
46 transfer = BComp "liveness analysis" exit last middle first
49 middle = flip middleLiveness
50 last = flip lastLiveness
52 -- | The transfer equations use the traditional 'gen' and 'kill'
53 -- notations, which should be familiar from the dragon book.
54 gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
55 gen a live = foldRegsUsed extendRegSet live a
56 kill a live = foldRegsUsed delOneFromUniqSet live a
58 middleLiveness :: Middle -> CmmLive -> CmmLive
59 middleLiveness m = middle m
60 where middle (MidNop) = id
61 middle (MidComment {}) = id
62 middle (MidAssign lhs expr) = gen expr . kill lhs
63 middle (MidStore addr rval) = gen addr . gen rval
64 middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress
65 middle (CopyIn _ formals _) = kill formals
66 middle (CopyOut _ formals) = gen formals
68 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
69 lastLiveness l env = last l
70 where last (LastReturn ress) = gen ress emptyUniqSet
71 last (LastJump e args) = gen e $ gen args emptyUniqSet
72 last (LastBranch id args) = gen args $ env id
73 last (LastCall tgt args (Just k)) = gen tgt $ gen args $ env k
74 last (LastCall tgt args Nothing) = gen tgt $ gen args $ emptyUniqSet
75 last (LastCondBranch e t f) = gen e $ unionUniqSets (env t) (env f)
76 last (LastSwitch e tbl) = gen e $ unionManyUniqSets $ map env (catMaybes tbl)