5346f4986ca8a2e828e78b240800a9572a321a1c
[ghc.git] / compiler / cmm / CmmLive.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE GADTs #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5
6 module CmmLive
7 ( CmmLocalLive
8 , cmmLocalLiveness
9 , cmmGlobalLiveness
10 , liveLattice
11 , gen_kill
12 )
13 where
14
15 import DynFlags
16 import BlockId
17 import Cmm
18 import PprCmmExpr ()
19 import Hoopl.Dataflow
20
21 import Maybes
22 import Outputable
23
24 -----------------------------------------------------------------------------
25 -- Calculating what variables are live on entry to a basic block
26 -----------------------------------------------------------------------------
27
28 -- | The variables live on entry to a block
29 type CmmLive r = RegSet r
30 type CmmLocalLive = CmmLive LocalReg
31
32 -- | The dataflow lattice
33 liveLattice :: Ord r => DataflowLattice (CmmLive r)
34 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
35 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
36 liveLattice = DataflowLattice emptyRegSet add
37 where
38 add (OldFact old) (NewFact new) =
39 let !join = plusRegSet old new
40 in changedIf (sizeRegSet join > sizeRegSet old) join
41
42
43 -- | A mapping from block labels to the variables live on entry
44 type BlockEntryLiveness r = BlockEnv (CmmLive r)
45
46 -----------------------------------------------------------------------------
47 -- | Calculated liveness info for a CmmGraph
48 -----------------------------------------------------------------------------
49
50 cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
51 cmmLocalLiveness dflags graph =
52 check $ dataflowAnalBwd graph [] liveLattice (xferLive dflags)
53 where entry = g_entry graph
54 check facts = noLiveOnEntry entry
55 (expectJust "check" $ mapLookup entry facts) facts
56
57 cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
58 cmmGlobalLiveness dflags graph =
59 dataflowAnalBwd graph [] liveLattice (xferLive dflags)
60
61 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
62 noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
63 noLiveOnEntry bid in_fact x =
64 if nullRegSet in_fact then x
65 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
66
67 -- | The transfer equations use the traditional 'gen' and 'kill'
68 -- notations, which should be familiar from the Dragon Book.
69 gen :: UserOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
70 {-# INLINE gen #-}
71 gen dflags a live = foldRegsUsed dflags extendRegSet live a
72
73 kill :: DefinerOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
74 {-# INLINE kill #-}
75 kill dflags a live = foldRegsDefd dflags deleteFromRegSet live a
76
77 gen_kill :: (DefinerOfRegs r a, UserOfRegs r a)
78 => DynFlags -> a -> CmmLive r -> CmmLive r
79 {-# INLINE gen_kill #-}
80 gen_kill dflags a = gen dflags a . kill dflags a
81
82 -- | The transfer function
83 xferLive :: forall r . ( UserOfRegs r (CmmNode O O)
84 , DefinerOfRegs r (CmmNode O O)
85 , UserOfRegs r (CmmNode O C)
86 , DefinerOfRegs r (CmmNode O C))
87 => DynFlags -> BwdTransfer CmmNode (CmmLive r)
88 {-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive LocalReg) #-}
89 {-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive GlobalReg) #-}
90 xferLive dflags = mkBTransfer3 fst mid lst
91 where fst _ f = f
92 mid :: CmmNode O O -> CmmLive r -> CmmLive r
93 mid n f = gen_kill dflags n f
94 lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
95 lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f