never executed always true always false
1 {-# LANGUAGE RecordWildCards #-}
2
3 -- | Put common type definitions here to break recursive module dependencies.
4
5 module GHC.CmmToAsm.Reg.Linear.Base (
6 BlockAssignment,
7 lookupBlockAssignment,
8 lookupFirstUsed,
9 emptyBlockAssignment,
10 updateBlockAssignment,
11
12 Loc(..),
13 regsOfLoc,
14
15 -- for stats
16 SpillReason(..),
17 RegAllocStats(..),
18
19 -- the allocator monad
20 RA_State(..),
21 )
22
23 where
24
25 import GHC.Prelude
26
27 import GHC.CmmToAsm.Reg.Linear.StackMap
28 import GHC.CmmToAsm.Reg.Liveness
29 import GHC.CmmToAsm.Config
30 import GHC.Platform.Reg
31
32 import GHC.Utils.Outputable
33 import GHC.Types.Unique
34 import GHC.Types.Unique.FM
35 import GHC.Types.Unique.Supply
36 import GHC.Cmm.BlockId
37 import GHC.Cmm.Dataflow.Collections
38 import GHC.CmmToAsm.Reg.Utils
39
40 data ReadingOrWriting = Reading | Writing deriving (Eq,Ord)
41
42 -- | Used to store the register assignment on entry to a basic block.
43 -- We use this to handle join points, where multiple branch instructions
44 -- target a particular label. We have to insert fixup code to make
45 -- the register assignments from the different sources match up.
46 --
47 data BlockAssignment freeRegs
48 = BlockAssignment { blockMap :: !(BlockMap (freeRegs, RegMap Loc))
49 , firstUsed :: !(UniqFM VirtualReg RealReg) }
50
51 -- | Find the register mapping for a specific BlockId.
52 lookupBlockAssignment :: BlockId -> BlockAssignment freeRegs -> Maybe (freeRegs, RegMap Loc)
53 lookupBlockAssignment bid ba = mapLookup bid (blockMap ba)
54
55 -- | Lookup which register a virtual register was first assigned to.
56 lookupFirstUsed :: VirtualReg -> BlockAssignment freeRegs -> Maybe RealReg
57 lookupFirstUsed vr ba = lookupUFM (firstUsed ba) vr
58
59 -- | An initial empty 'BlockAssignment'
60 emptyBlockAssignment :: BlockAssignment freeRegs
61 emptyBlockAssignment = BlockAssignment mapEmpty mempty
62
63 -- | Add new register mappings for a specific block.
64 updateBlockAssignment :: BlockId
65 -> (freeRegs, RegMap Loc)
66 -> BlockAssignment freeRegs
67 -> BlockAssignment freeRegs
68 updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) =
69 BlockAssignment (mapInsert dest (freeRegs, regMap) blockMap)
70 (mergeUFM combWithExisting id (mapMaybeUFM fromLoc) (firstUsed) (toVRegMap regMap))
71 where
72 -- The blocks are processed in dependency order, so if there's already an
73 -- entry in the map then keep that assignment rather than writing the new
74 -- assignment.
75 combWithExisting :: RealReg -> Loc -> Maybe RealReg
76 combWithExisting old_reg _ = Just $ old_reg
77
78 fromLoc :: Loc -> Maybe RealReg
79 fromLoc (InReg rr) = Just rr
80 fromLoc (InBoth rr _) = Just rr
81 fromLoc _ = Nothing
82
83
84 -- | Where a vreg is currently stored
85 -- A temporary can be marked as living in both a register and memory
86 -- (InBoth), for example if it was recently loaded from a spill location.
87 -- This makes it cheap to spill (no save instruction required), but we
88 -- have to be careful to turn this into InReg if the value in the
89 -- register is changed.
90
91 -- This is also useful when a temporary is about to be clobbered. We
92 -- save it in a spill location, but mark it as InBoth because the current
93 -- instruction might still want to read it.
94 --
95 data Loc
96 -- | vreg is in a register
97 = InReg !RealReg
98
99 -- | vreg is held in a stack slot
100 | InMem {-# UNPACK #-} !StackSlot
101
102
103 -- | vreg is held in both a register and a stack slot
104 | InBoth !RealReg
105 {-# UNPACK #-} !StackSlot
106 deriving (Eq, Show, Ord)
107
108 instance Outputable Loc where
109 ppr l = text (show l)
110
111
112 -- | Get the reg numbers stored in this Loc.
113 regsOfLoc :: Loc -> [RealReg]
114 regsOfLoc (InReg r) = [r]
115 regsOfLoc (InBoth r _) = [r]
116 regsOfLoc (InMem _) = []
117
118
119 -- | Reasons why instructions might be inserted by the spiller.
120 -- Used when generating stats for -ddrop-asm-stats.
121 --
122 data SpillReason
123 -- | vreg was spilled to a slot so we could use its
124 -- current hreg for another vreg
125 = SpillAlloc !Unique
126
127 -- | vreg was moved because its hreg was clobbered
128 | SpillClobber !Unique
129
130 -- | vreg was loaded from a spill slot
131 | SpillLoad !Unique
132
133 -- | reg-reg move inserted during join to targets
134 | SpillJoinRR !Unique
135
136 -- | reg-mem move inserted during join to targets
137 | SpillJoinRM !Unique
138
139
140 -- | Used to carry interesting stats out of the register allocator.
141 data RegAllocStats
142 = RegAllocStats
143 { ra_spillInstrs :: UniqFM Unique [Int] -- Keys are the uniques of regs
144 -- and taken from SpillReason
145 -- See Note [UniqFM and the register allocator]
146 , ra_fixupList :: [(BlockId,BlockId,BlockId)]
147 -- ^ (from,fixup,to) : We inserted fixup code between from and to
148 }
149
150
151 -- | The register allocator state
152 data RA_State freeRegs
153 = RA_State
154
155 {
156 -- | the current mapping from basic blocks to
157 -- the register assignments at the beginning of that block.
158 ra_blockassig :: BlockAssignment freeRegs
159
160 -- | free machine registers
161 , ra_freeregs :: !freeRegs
162
163 -- | assignment of temps to locations
164 , ra_assig :: RegMap Loc
165
166 -- | current stack delta
167 , ra_delta :: Int
168
169 -- | free stack slots for spilling
170 , ra_stack :: StackMap
171
172 -- | unique supply for generating names for join point fixup blocks.
173 , ra_us :: UniqSupply
174
175 -- | Record why things were spilled, for -ddrop-asm-stats.
176 -- Just keep a list here instead of a map of regs -> reasons.
177 -- We don't want to slow down the allocator if we're not going to emit the stats.
178 , ra_spills :: [SpillReason]
179
180 -- | Native code generator configuration
181 , ra_config :: !NCGConfig
182
183 -- | (from,fixup,to) : We inserted fixup code between from and to
184 , ra_fixups :: [(BlockId,BlockId,BlockId)]
185
186 }
187
188