2 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
8 , noLiveOnEntry, xferLive
16 import OptimizationFuel
24 -----------------------------------------------------------------------------
25 -- Calculating what variables are live on entry to a basic block
26 -----------------------------------------------------------------------------
28 -- | The variables live on entry to a block
31 -- | The dataflow lattice
32 liveLattice :: DataflowLattice CmmLive
33 liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
34 where add _ (OldFact old) (NewFact new) = case unionUniqSets old new of
35 join -> (changeIf $ sizeUniqSet join > sizeUniqSet old, join)
37 -- | A mapping from block labels to the variables live on entry
38 type BlockEntryLiveness = BlockEnv CmmLive
40 -----------------------------------------------------------------------------
41 -- | Calculated liveness info for a CmmGraph
42 -----------------------------------------------------------------------------
44 cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness
46 liftM check $ liftM snd $ dataflowPassBwd graph [] $ analBwd liveLattice xferLive
47 where entry = g_entry graph
48 check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts
50 gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
51 gen_kill a = gen a . kill a
53 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
54 noLiveOnEntry :: BlockId -> CmmLive -> a -> a
55 noLiveOnEntry bid in_fact x =
56 if isEmptyUniqSet in_fact then x
57 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
59 -- | The transfer equations use the traditional 'gen' and 'kill'
60 -- notations, which should be familiar from the dragon book.
61 gen :: UserOfLocalRegs a => a -> RegSet -> RegSet
62 gen a live = foldRegsUsed extendRegSet live a
63 kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
64 kill a live = foldRegsDefd delOneFromUniqSet live a
67 xferLive :: BwdTransfer CmmNode CmmLive
68 xferLive = mkBTransfer3 fst mid lst
70 mid :: CmmNode O O -> CmmLive -> CmmLive
71 mid n f = gen_kill n f
72 lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
73 lst n f = gen_kill n $ case n of CmmCall {} -> emptyRegSet
74 CmmForeignCall {} -> emptyRegSet
75 _ -> joinOutFacts liveLattice n f