never executed always true always false
1
2
3 module GHC.CmmToAsm.X86.Regs (
4 -- squeese functions for the graph allocator
5 virtualRegSqueeze,
6 realRegSqueeze,
7
8 -- immediates
9 Imm(..),
10 strImmLit,
11 litToImm,
12
13 -- addressing modes
14 AddrMode(..),
15 addrOffset,
16
17 -- registers
18 spRel,
19 argRegs,
20 allArgRegs,
21 allIntArgRegs,
22 callClobberedRegs,
23 instrClobberedRegs,
24 allMachRegNos,
25 classOfRealReg,
26 showReg,
27
28 -- machine specific
29 EABase(..), EAIndex(..), addrModeRegs,
30
31 eax, ebx, ecx, edx, esi, edi, ebp, esp,
32
33
34 rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,
35 r8, r9, r10, r11, r12, r13, r14, r15,
36 lastint,
37 xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
38 xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,
39 xmm,
40 firstxmm, lastxmm,
41
42 ripRel,
43 allFPArgRegs,
44
45 allocatableRegs
46 )
47
48 where
49
50 import GHC.Prelude
51
52 import GHC.Platform.Regs
53 import GHC.Platform.Reg
54 import GHC.Platform.Reg.Class
55
56 import GHC.Cmm
57 import GHC.Cmm.CLabel ( CLabel )
58 import GHC.Utils.Outputable
59 import GHC.Utils.Panic
60 import GHC.Platform
61
62 import qualified Data.Array as A
63
64 -- | regSqueeze_class reg
65 -- Calculate the maximum number of register colors that could be
66 -- denied to a node of this class due to having this reg
67 -- as a neighbour.
68 --
69 {-# INLINE virtualRegSqueeze #-}
70 virtualRegSqueeze :: RegClass -> VirtualReg -> Int
71
72 virtualRegSqueeze cls vr
73 = case cls of
74 RcInteger
75 -> case vr of
76 VirtualRegI{} -> 1
77 VirtualRegHi{} -> 1
78 _other -> 0
79
80 RcDouble
81 -> case vr of
82 VirtualRegD{} -> 1
83 VirtualRegF{} -> 0
84 _other -> 0
85
86
87 _other -> 0
88
89 {-# INLINE realRegSqueeze #-}
90 realRegSqueeze :: RegClass -> RealReg -> Int
91 realRegSqueeze cls rr
92 = case cls of
93 RcInteger
94 -> case rr of
95 RealRegSingle regNo
96 | regNo < firstxmm -> 1
97 | otherwise -> 0
98
99 RealRegPair{} -> 0
100
101 RcDouble
102 -> case rr of
103 RealRegSingle regNo
104 | regNo >= firstxmm -> 1
105 | otherwise -> 0
106
107 RealRegPair{} -> 0
108
109
110 _other -> 0
111
112 -- -----------------------------------------------------------------------------
113 -- Immediates
114
115 data Imm
116 = ImmInt Int
117 | ImmInteger Integer -- Sigh.
118 | ImmCLbl CLabel -- AbstractC Label (with baggage)
119 | ImmLit SDoc -- Simple string
120 | ImmIndex CLabel Int
121 | ImmFloat Rational
122 | ImmDouble Rational
123 | ImmConstantSum Imm Imm
124 | ImmConstantDiff Imm Imm
125
126 strImmLit :: String -> Imm
127 strImmLit s = ImmLit (text s)
128
129
130 litToImm :: CmmLit -> Imm
131 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
132 -- narrow to the width: a CmmInt might be out of
133 -- range, but we assume that ImmInteger only contains
134 -- in-range values. A signed value should be fine here.
135 litToImm (CmmFloat f W32) = ImmFloat f
136 litToImm (CmmFloat f W64) = ImmDouble f
137 litToImm (CmmLabel l) = ImmCLbl l
138 litToImm (CmmLabelOff l off) = ImmIndex l off
139 litToImm (CmmLabelDiffOff l1 l2 off _)
140 = ImmConstantSum
141 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
142 (ImmInt off)
143 litToImm _ = panic "X86.Regs.litToImm: no match"
144
145 -- addressing modes ------------------------------------------------------------
146
147 data AddrMode
148 = AddrBaseIndex EABase EAIndex Displacement
149 | ImmAddr Imm Int
150
151 data EABase = EABaseNone | EABaseReg Reg | EABaseRip
152 data EAIndex = EAIndexNone | EAIndex Reg Int
153 type Displacement = Imm
154
155
156 addrOffset :: AddrMode -> Int -> Maybe AddrMode
157 addrOffset addr off
158 = case addr of
159 ImmAddr i off0 -> Just (ImmAddr i (off0 + off))
160
161 AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
162 AddrBaseIndex r i (ImmInteger n)
163 -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
164
165 AddrBaseIndex r i (ImmCLbl lbl)
166 -> Just (AddrBaseIndex r i (ImmIndex lbl off))
167
168 AddrBaseIndex r i (ImmIndex lbl ix)
169 -> Just (AddrBaseIndex r i (ImmIndex lbl (ix+off)))
170
171 _ -> Nothing -- in theory, shouldn't happen
172
173
174 addrModeRegs :: AddrMode -> [Reg]
175 addrModeRegs (AddrBaseIndex b i _) = b_regs ++ i_regs
176 where
177 b_regs = case b of { EABaseReg r -> [r]; _ -> [] }
178 i_regs = case i of { EAIndex r _ -> [r]; _ -> [] }
179 addrModeRegs _ = []
180
181
182 -- registers -------------------------------------------------------------------
183
184 -- @spRel@ gives us a stack relative addressing mode for volatile
185 -- temporaries and for excess call arguments. @fpRel@, where
186 -- applicable, is the same but for the frame pointer.
187
188
189 spRel :: Platform
190 -> Int -- ^ desired stack offset in bytes, positive or negative
191 -> AddrMode
192 spRel platform n
193 | target32Bit platform
194 = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt n)
195 | otherwise
196 = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt n)
197
198 -- The register numbers must fit into 32 bits on x86, so that we can
199 -- use a Word32 to represent the set of free registers in the register
200 -- allocator.
201
202
203
204 firstxmm :: RegNo
205 firstxmm = 16
206
207 -- on 32bit platformOSs, only the first 8 XMM/YMM/ZMM registers are available
208 lastxmm :: Platform -> RegNo
209 lastxmm platform
210 | target32Bit platform = firstxmm + 7 -- xmm0 - xmmm7
211 | otherwise = firstxmm + 15 -- xmm0 -xmm15
212
213 lastint :: Platform -> RegNo
214 lastint platform
215 | target32Bit platform = 7 -- not %r8..%r15
216 | otherwise = 15
217
218 intregnos :: Platform -> [RegNo]
219 intregnos platform = [0 .. lastint platform]
220
221
222
223 xmmregnos :: Platform -> [RegNo]
224 xmmregnos platform = [firstxmm .. lastxmm platform]
225
226 floatregnos :: Platform -> [RegNo]
227 floatregnos platform = xmmregnos platform
228
229 -- argRegs is the set of regs which are read for an n-argument call to C.
230 -- For archs which pass all args on the stack (x86), is empty.
231 -- Sparc passes up to the first 6 args in regs.
232 argRegs :: RegNo -> [Reg]
233 argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
234
235 -- | The complete set of machine registers.
236 allMachRegNos :: Platform -> [RegNo]
237 allMachRegNos platform = intregnos platform ++ floatregnos platform
238
239 -- | Take the class of a register.
240 {-# INLINE classOfRealReg #-}
241 classOfRealReg :: Platform -> RealReg -> RegClass
242 -- On x86, we might want to have an 8-bit RegClass, which would
243 -- contain just regs 1-4 (the others don't have 8-bit versions).
244 -- However, we can get away without this at the moment because the
245 -- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
246 classOfRealReg platform reg
247 = case reg of
248 RealRegSingle i
249 | i <= lastint platform -> RcInteger
250 | i <= lastxmm platform -> RcDouble
251 | otherwise -> panic "X86.Reg.classOfRealReg registerSingle too high"
252 _ -> panic "X86.Regs.classOfRealReg: RegPairs on this arch"
253
254 -- | Get the name of the register with this number.
255 -- NOTE: fixme, we dont track which "way" the XMM registers are used
256 showReg :: Platform -> RegNo -> String
257 showReg platform n
258 | n >= firstxmm && n <= lastxmm platform = "%xmm" ++ show (n-firstxmm)
259 | n >= 8 && n < firstxmm = "%r" ++ show n
260 | otherwise = regNames platform A.! n
261
262 regNames :: Platform -> A.Array Int String
263 regNames platform
264 = if target32Bit platform
265 then A.listArray (0,8) ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp"]
266 else A.listArray (0,8) ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp"]
267
268
269
270 -- machine specific ------------------------------------------------------------
271
272
273 {-
274 Intel x86 architecture:
275 - All registers except 7 (esp) are available for use.
276 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
277 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
278 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
279
280 The fp registers are all Double registers; we don't have any RcFloat class
281 regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
282 never generate them.
283
284 TODO: cleanup modelling float vs double registers and how they are the same class.
285 -}
286
287
288 eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg
289
290 eax = regSingle 0
291 ebx = regSingle 1
292 ecx = regSingle 2
293 edx = regSingle 3
294 esi = regSingle 4
295 edi = regSingle 5
296 ebp = regSingle 6
297 esp = regSingle 7
298
299
300
301
302 {-
303 AMD x86_64 architecture:
304 - All 16 integer registers are addressable as 8, 16, 32 and 64-bit values:
305
306 8 16 32 64
307 ---------------------
308 al ax eax rax
309 bl bx ebx rbx
310 cl cx ecx rcx
311 dl dx edx rdx
312 sil si esi rsi
313 dil si edi rdi
314 bpl bp ebp rbp
315 spl sp esp rsp
316 r10b r10w r10d r10
317 r11b r11w r11d r11
318 r12b r12w r12d r12
319 r13b r13w r13d r13
320 r14b r14w r14d r14
321 r15b r15w r15d r15
322 -}
323
324 rax, rbx, rcx, rdx, rsp, rbp, rsi, rdi,
325 r8, r9, r10, r11, r12, r13, r14, r15,
326 xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
327 xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15 :: Reg
328
329 rax = regSingle 0
330 rbx = regSingle 1
331 rcx = regSingle 2
332 rdx = regSingle 3
333 rsi = regSingle 4
334 rdi = regSingle 5
335 rbp = regSingle 6
336 rsp = regSingle 7
337 r8 = regSingle 8
338 r9 = regSingle 9
339 r10 = regSingle 10
340 r11 = regSingle 11
341 r12 = regSingle 12
342 r13 = regSingle 13
343 r14 = regSingle 14
344 r15 = regSingle 15
345 xmm0 = regSingle 16
346 xmm1 = regSingle 17
347 xmm2 = regSingle 18
348 xmm3 = regSingle 19
349 xmm4 = regSingle 20
350 xmm5 = regSingle 21
351 xmm6 = regSingle 22
352 xmm7 = regSingle 23
353 xmm8 = regSingle 24
354 xmm9 = regSingle 25
355 xmm10 = regSingle 26
356 xmm11 = regSingle 27
357 xmm12 = regSingle 28
358 xmm13 = regSingle 29
359 xmm14 = regSingle 30
360 xmm15 = regSingle 31
361
362 ripRel :: Displacement -> AddrMode
363 ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
364
365
366 -- so we can re-use some x86 code:
367 {-
368 eax = rax
369 ebx = rbx
370 ecx = rcx
371 edx = rdx
372 esi = rsi
373 edi = rdi
374 ebp = rbp
375 esp = rsp
376 -}
377
378 xmm :: RegNo -> Reg
379 xmm n = regSingle (firstxmm+n)
380
381
382
383
384 -- | these are the regs which we cannot assume stay alive over a C call.
385 callClobberedRegs :: Platform -> [Reg]
386 -- caller-saves registers
387 callClobberedRegs platform
388 | target32Bit platform = [eax,ecx,edx] ++ map regSingle (floatregnos platform)
389 | platformOS platform == OSMinGW32
390 = [rax,rcx,rdx,r8,r9,r10,r11]
391 -- Only xmm0-5 are caller-saves registers on 64bit windows.
392 -- ( https://docs.microsoft.com/en-us/cpp/build/register-usage )
393 -- For details check the Win64 ABI.
394 ++ map xmm [0 .. 5]
395 | otherwise
396 -- all xmm regs are caller-saves
397 -- caller-saves registers
398 = [rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11]
399 ++ map regSingle (floatregnos platform)
400
401 allArgRegs :: Platform -> [(Reg, Reg)]
402 allArgRegs platform
403 | platformOS platform == OSMinGW32 = zip [rcx,rdx,r8,r9]
404 (map regSingle [firstxmm ..])
405 | otherwise = panic "X86.Regs.allArgRegs: not defined for this arch"
406
407 allIntArgRegs :: Platform -> [Reg]
408 allIntArgRegs platform
409 | (platformOS platform == OSMinGW32) || target32Bit platform
410 = panic "X86.Regs.allIntArgRegs: not defined for this platform"
411 | otherwise = [rdi,rsi,rdx,rcx,r8,r9]
412
413
414 -- | on 64bit platforms we pass the first 8 float/double arguments
415 -- in the xmm registers.
416 allFPArgRegs :: Platform -> [Reg]
417 allFPArgRegs platform
418 | platformOS platform == OSMinGW32
419 = panic "X86.Regs.allFPArgRegs: not defined for this platform"
420 | otherwise = map regSingle [firstxmm .. firstxmm + 7 ]
421
422
423 -- Machine registers which might be clobbered by instructions that
424 -- generate results into fixed registers, or need arguments in a fixed
425 -- register.
426 instrClobberedRegs :: Platform -> [Reg]
427 instrClobberedRegs platform
428 | target32Bit platform = [ eax, ecx, edx ]
429 | otherwise = [ rax, rcx, rdx ]
430
431 --
432
433 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
434 -- i.e., these are the regs for which we are prepared to allow the
435 -- register allocator to attempt to map VRegs to.
436 allocatableRegs :: Platform -> [RealReg]
437 allocatableRegs platform
438 = let isFree i = freeReg platform i
439 in map RealRegSingle $ filter isFree (allMachRegNos platform)
440