Add support for producing position-independent executables
[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.Block
20 import Hoopl.Collections
21 import Hoopl.Dataflow
22 import Hoopl.Label
23
24 import Maybes
25 import Outputable
26
27 -----------------------------------------------------------------------------
28 -- Calculating what variables are live on entry to a basic block
29 -----------------------------------------------------------------------------
30
31 -- | The variables live on entry to a block
32 type CmmLive r = RegSet r
33 type CmmLocalLive = CmmLive LocalReg
34
35 -- | The dataflow lattice
36 liveLattice :: Ord r => DataflowLattice (CmmLive r)
37 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
38 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
39 liveLattice = DataflowLattice emptyRegSet add
40 where
41 add (OldFact old) (NewFact new) =
42 let !join = plusRegSet old new
43 in changedIf (sizeRegSet join > sizeRegSet old) join
44
45 -- | A mapping from block labels to the variables live on entry
46 type BlockEntryLiveness r = LabelMap (CmmLive r)
47
48 -----------------------------------------------------------------------------
49 -- | Calculated liveness info for a CmmGraph
50 -----------------------------------------------------------------------------
51
52 cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
53 cmmLocalLiveness dflags graph =
54 check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
55 where
56 entry = g_entry graph
57 check facts =
58 noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts
59
60 cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
61 cmmGlobalLiveness dflags graph =
62 analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
63
64 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
65 noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
66 noLiveOnEntry bid in_fact x =
67 if nullRegSet in_fact then x
68 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
69
70 gen_kill
71 :: (DefinerOfRegs r n, UserOfRegs r n)
72 => DynFlags -> n -> CmmLive r -> CmmLive r
73 gen_kill dflags node set =
74 let !afterKill = foldRegsDefd dflags deleteFromRegSet set node
75 in foldRegsUsed dflags extendRegSet afterKill node
76 {-# INLINE gen_kill #-}
77
78 xferLive
79 :: forall r.
80 ( UserOfRegs r (CmmNode O O)
81 , DefinerOfRegs r (CmmNode O O)
82 , UserOfRegs r (CmmNode O C)
83 , DefinerOfRegs r (CmmNode O C)
84 )
85 => DynFlags -> TransferFun (CmmLive r)
86 xferLive dflags (BlockCC eNode middle xNode) fBase =
87 let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase
88 !result = foldNodesBwdOO (gen_kill dflags) middle joined
89 in mapSingleton (entryLabel eNode) result
90 {-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-}
91 {-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-}