Some -dynamic-too fixes
[ghc.git] / compiler / cmm / CmmLive.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4
5 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
6
7 module CmmLive
8 ( CmmLocalLive
9 , CmmGlobalLive
10 , cmmLocalLiveness
11 , cmmGlobalLiveness
12 , liveLattice
13 , noLiveOnEntry, xferLive, gen, kill, gen_kill
14 , removeDeadAssignments
15 )
16 where
17
18 import UniqSupply
19 import DynFlags
20 import BlockId
21 import Cmm
22 import CmmUtils
23 import PprCmmExpr ()
24
25 import Hoopl
26 import Maybes
27 import Outputable
28
29 -----------------------------------------------------------------------------
30 -- Calculating what variables are live on entry to a basic block
31 -----------------------------------------------------------------------------
32
33 -- | The variables live on entry to a block
34 type CmmLive r = RegSet r
35 type CmmLocalLive = CmmLive LocalReg
36 type CmmGlobalLive = CmmLive GlobalReg
37
38 -- | The dataflow lattice
39 liveLattice :: Ord r => DataflowLattice (CmmLive r)
40 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
41 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
42 liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
43 where add _ (OldFact old) (NewFact new) =
44 (changeIf $ sizeRegSet join > sizeRegSet old, join)
45 where !join = plusRegSet old new
46
47
48 -- | A mapping from block labels to the variables live on entry
49 type BlockEntryLiveness r = BlockEnv (CmmLive r)
50
51 -----------------------------------------------------------------------------
52 -- | Calculated liveness info for a CmmGraph
53 -----------------------------------------------------------------------------
54
55 cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
56 cmmLocalLiveness dflags graph =
57 check $ dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)
58 where entry = g_entry graph
59 check facts = noLiveOnEntry entry
60 (expectJust "check" $ mapLookup entry facts) facts
61
62 cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
63 cmmGlobalLiveness dflags graph =
64 dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)
65
66 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
67 noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
68 noLiveOnEntry bid in_fact x =
69 if nullRegSet in_fact then x
70 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
71
72 -- | The transfer equations use the traditional 'gen' and 'kill'
73 -- notations, which should be familiar from the Dragon Book.
74 gen :: UserOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
75 {-# INLINE gen #-}
76 gen dflags a live = foldRegsUsed dflags extendRegSet live a
77
78 kill :: DefinerOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
79 {-# INLINE kill #-}
80 kill dflags a live = foldRegsDefd dflags deleteFromRegSet live a
81
82 gen_kill :: (DefinerOfRegs r a, UserOfRegs r a)
83 => DynFlags -> a -> CmmLive r -> CmmLive r
84 {-# INLINE gen_kill #-}
85 gen_kill dflags a = gen dflags a . kill dflags a
86
87 -- | The transfer function
88 xferLive :: forall r . ( UserOfRegs r (CmmNode O O)
89 , DefinerOfRegs r (CmmNode O O)
90 , UserOfRegs r (CmmNode O C)
91 , DefinerOfRegs r (CmmNode O C))
92 => DynFlags -> BwdTransfer CmmNode (CmmLive r)
93 {-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive LocalReg) #-}
94 {-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive GlobalReg) #-}
95 xferLive dflags = mkBTransfer3 fst mid lst
96 where fst _ f = f
97 mid :: CmmNode O O -> CmmLive r -> CmmLive r
98 mid n f = gen_kill dflags n f
99 lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
100 lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f
101
102 -----------------------------------------------------------------------------
103 -- Removing assignments to dead variables
104 -----------------------------------------------------------------------------
105
106 removeDeadAssignments :: DynFlags -> CmmGraph
107 -> UniqSM (CmmGraph, BlockEnv CmmLocalLive)
108 removeDeadAssignments dflags g =
109 dataflowPassBwd g [] $ analRewBwd liveLattice (xferLive dflags) rewrites
110 where rewrites = mkBRewrite3 nothing middle nothing
111 -- SDM: no need for deepBwdRw here, we only rewrite to empty
112 -- Beware: deepBwdRw with one polymorphic function seems more
113 -- reasonable here, but GHC panics while compiling, see bug
114 -- #4045.
115 middle :: CmmNode O O -> Fact O CmmLocalLive -> CmmReplGraph O O
116 middle (CmmAssign (CmmLocal reg') _) live
117 | not (reg' `elemRegSet` live)
118 = return $ Just emptyGraph
119 -- XXX maybe this should be somewhere else...
120 middle (CmmAssign lhs (CmmReg rhs)) _ | lhs == rhs
121 = return $ Just emptyGraph
122 middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs
123 = return $ Just emptyGraph
124 middle _ _ = return Nothing
125
126 nothing :: CmmNode e x -> Fact x CmmLocalLive -> CmmReplGraph e x
127 nothing _ _ = return Nothing