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