Typofixes in comments and whitespace only [ci skip]
[ghc.git] / compiler / cmm / CmmExpr.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE UndecidableInstances #-}
6
7 module CmmExpr
8 ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
9 , CmmReg(..), cmmRegType
10 , CmmLit(..), cmmLitType
11 , LocalReg(..), localRegType
12 , GlobalReg(..), isArgReg, globalRegType
13 , spReg, hpReg, spLimReg, hpLimReg, nodeReg
14 , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
15 , node, baseReg
16 , VGcPtr(..)
17
18 , DefinerOfRegs, UserOfRegs
19 , foldRegsDefd, foldRegsUsed
20 , foldLocalRegsDefd, foldLocalRegsUsed
21
22 , RegSet, LocalRegSet, GlobalRegSet
23 , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
24 , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
25 , regSetToList
26
27 , Area(..)
28 , module CmmMachOp
29 , module CmmType
30 )
31 where
32
33 import GhcPrelude
34
35 import BlockId
36 import CLabel
37 import CmmMachOp
38 import CmmType
39 import DynFlags
40 import Outputable (panic)
41 import Unique
42
43 import Data.Set (Set)
44 import Data.List
45 import qualified Data.Set as Set
46
47 -----------------------------------------------------------------------------
48 -- CmmExpr
49 -- An expression. Expressions have no side effects.
50 -----------------------------------------------------------------------------
51
52 data CmmExpr
53 = CmmLit CmmLit -- Literal
54 | CmmLoad !CmmExpr !CmmType -- Read memory location
55 | CmmReg !CmmReg -- Contents of register
56 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.)
57 | CmmStackSlot Area {-# UNPACK #-} !Int
58 -- addressing expression of a stack slot
59 -- See Note [CmmStackSlot aliasing]
60 | CmmRegOff !CmmReg Int
61 -- CmmRegOff reg i
62 -- ** is shorthand only, meaning **
63 -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
64 -- where rep = typeWidth (cmmRegType reg)
65
66 instance Eq CmmExpr where -- Equality ignores the types
67 CmmLit l1 == CmmLit l2 = l1==l2
68 CmmLoad e1 _ == CmmLoad e2 _ = e1==e2
69 CmmReg r1 == CmmReg r2 = r1==r2
70 CmmRegOff r1 i1 == CmmRegOff r2 i2 = r1==r2 && i1==i2
71 CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2
72 CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
73 _e1 == _e2 = False
74
75 data CmmReg
76 = CmmLocal {-# UNPACK #-} !LocalReg
77 | CmmGlobal GlobalReg
78 deriving( Eq, Ord )
79
80 -- | A stack area is either the stack slot where a variable is spilled
81 -- or the stack space where function arguments and results are passed.
82 data Area
83 = Old -- See Note [Old Area]
84 | Young {-# UNPACK #-} !BlockId -- Invariant: must be a continuation BlockId
85 -- See Note [Continuation BlockId] in CmmNode.
86 deriving (Eq, Ord)
87
88 {- Note [Old Area]
89 ~~~~~~~~~~~~~~~~~~
90 There is a single call area 'Old', allocated at the extreme old
91 end of the stack frame (ie just younger than the return address)
92 which holds:
93 * incoming (overflow) parameters,
94 * outgoing (overflow) parameter to tail calls,
95 * outgoing (overflow) result values
96 * the update frame (if any)
97
98 Its size is the max of all these requirements. On entry, the stack
99 pointer will point to the youngest incoming parameter, which is not
100 necessarily at the young end of the Old area.
101
102 End of note -}
103
104
105 {- Note [CmmStackSlot aliasing]
106 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
107 When do two CmmStackSlots alias?
108
109 - T[old+N] aliases with U[young(L)+M] for all T, U, L, N and M
110 - T[old+N] aliases with U[old+M] only if the areas actually overlap
111
112 Or more informally, different Areas may overlap with each other.
113
114 An alternative semantics, that we previously had, was that different
115 Areas do not overlap. The problem that lead to redefining the
116 semantics of stack areas is described below.
117
118 e.g. if we had
119
120 x = Sp[old + 8]
121 y = Sp[old + 16]
122
123 Sp[young(L) + 8] = L
124 Sp[young(L) + 16] = y
125 Sp[young(L) + 24] = x
126 call f() returns to L
127
128 if areas semantically do not overlap, then we might optimise this to
129
130 Sp[young(L) + 8] = L
131 Sp[young(L) + 16] = Sp[old + 8]
132 Sp[young(L) + 24] = Sp[old + 16]
133 call f() returns to L
134
135 and now young(L) cannot be allocated at the same place as old, and we
136 are doomed to use more stack.
137
138 - old+8 conflicts with young(L)+8
139 - old+16 conflicts with young(L)+16 and young(L)+8
140
141 so young(L)+8 == old+24 and we get
142
143 Sp[-8] = L
144 Sp[-16] = Sp[8]
145 Sp[-24] = Sp[0]
146 Sp -= 24
147 call f() returns to L
148
149 However, if areas are defined to be "possibly overlapping" in the
150 semantics, then we cannot commute any loads/stores of old with
151 young(L), and we will be able to re-use both old+8 and old+16 for
152 young(L).
153
154 x = Sp[8]
155 y = Sp[0]
156
157 Sp[8] = L
158 Sp[0] = y
159 Sp[-8] = x
160 Sp = Sp - 8
161 call f() returns to L
162
163 Now, the assignments of y go away,
164
165 x = Sp[8]
166 Sp[8] = L
167 Sp[-8] = x
168 Sp = Sp - 8
169 call f() returns to L
170 -}
171
172 data CmmLit
173 = CmmInt !Integer Width
174 -- Interpretation: the 2's complement representation of the value
175 -- is truncated to the specified size. This is easier than trying
176 -- to keep the value within range, because we don't know whether
177 -- it will be used as a signed or unsigned value (the CmmType doesn't
178 -- distinguish between signed & unsigned).
179 | CmmFloat Rational Width
180 | CmmVec [CmmLit] -- Vector literal
181 | CmmLabel CLabel -- Address of label
182 | CmmLabelOff CLabel Int -- Address of label + byte offset
183
184 -- Due to limitations in the C backend, the following
185 -- MUST ONLY be used inside the info table indicated by label2
186 -- (label2 must be the info label), and label1 must be an
187 -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
188 -- Don't use it at all unless tablesNextToCode.
189 -- It is also used inside the NCG during when generating
190 -- position-independent code.
191 | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset
192 -- In an expression, the width just has the effect of MO_SS_Conv
193 -- from wordWidth to the desired width.
194 --
195 -- In a static literal, the supported Widths depend on the
196 -- architecture: wordWidth is supported on all
197 -- architectures. Additionally W32 is supported on x86_64 when
198 -- using the small memory model.
199
200 | CmmBlock {-# UNPACK #-} !BlockId -- Code label
201 -- Invariant: must be a continuation BlockId
202 -- See Note [Continuation BlockId] in CmmNode.
203
204 | CmmHighStackMark -- A late-bound constant that stands for the max
205 -- #bytes of stack space used during a procedure.
206 -- During the stack-layout pass, CmmHighStackMark
207 -- is replaced by a CmmInt for the actual number
208 -- of bytes used
209 deriving Eq
210
211 cmmExprType :: DynFlags -> CmmExpr -> CmmType
212 cmmExprType dflags (CmmLit lit) = cmmLitType dflags lit
213 cmmExprType _ (CmmLoad _ rep) = rep
214 cmmExprType dflags (CmmReg reg) = cmmRegType dflags reg
215 cmmExprType dflags (CmmMachOp op args) = machOpResultType dflags op (map (cmmExprType dflags) args)
216 cmmExprType dflags (CmmRegOff reg _) = cmmRegType dflags reg
217 cmmExprType dflags (CmmStackSlot _ _) = bWord dflags -- an address
218 -- Careful though: what is stored at the stack slot may be bigger than
219 -- an address
220
221 cmmLitType :: DynFlags -> CmmLit -> CmmType
222 cmmLitType _ (CmmInt _ width) = cmmBits width
223 cmmLitType _ (CmmFloat _ width) = cmmFloat width
224 cmmLitType _ (CmmVec []) = panic "cmmLitType: CmmVec []"
225 cmmLitType cflags (CmmVec (l:ls)) = let ty = cmmLitType cflags l
226 in if all (`cmmEqType` ty) (map (cmmLitType cflags) ls)
227 then cmmVec (1+length ls) ty
228 else panic "cmmLitType: CmmVec"
229 cmmLitType dflags (CmmLabel lbl) = cmmLabelType dflags lbl
230 cmmLitType dflags (CmmLabelOff lbl _) = cmmLabelType dflags lbl
231 cmmLitType _ (CmmLabelDiffOff _ _ _ width) = cmmBits width
232 cmmLitType dflags (CmmBlock _) = bWord dflags
233 cmmLitType dflags (CmmHighStackMark) = bWord dflags
234
235 cmmLabelType :: DynFlags -> CLabel -> CmmType
236 cmmLabelType dflags lbl
237 | isGcPtrLabel lbl = gcWord dflags
238 | otherwise = bWord dflags
239
240 cmmExprWidth :: DynFlags -> CmmExpr -> Width
241 cmmExprWidth dflags e = typeWidth (cmmExprType dflags e)
242
243 --------
244 --- Negation for conditional branches
245
246 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
247 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
248 return (CmmMachOp op' args)
249 maybeInvertCmmExpr _ = Nothing
250
251 -----------------------------------------------------------------------------
252 -- Local registers
253 -----------------------------------------------------------------------------
254
255 data LocalReg
256 = LocalReg {-# UNPACK #-} !Unique CmmType
257 -- ^ Parameters:
258 -- 1. Identifier
259 -- 2. Type
260
261 instance Eq LocalReg where
262 (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
263
264 -- This is non-deterministic but we do not currently support deterministic
265 -- code-generation. See Note [Unique Determinism and code generation]
266 -- See Note [No Ord for Unique]
267 instance Ord LocalReg where
268 compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
269
270 instance Uniquable LocalReg where
271 getUnique (LocalReg uniq _) = uniq
272
273 cmmRegType :: DynFlags -> CmmReg -> CmmType
274 cmmRegType _ (CmmLocal reg) = localRegType reg
275 cmmRegType dflags (CmmGlobal reg) = globalRegType dflags reg
276
277 localRegType :: LocalReg -> CmmType
278 localRegType (LocalReg _ rep) = rep
279
280 -----------------------------------------------------------------------------
281 -- Register-use information for expressions and other types
282 -----------------------------------------------------------------------------
283
284 -- | Sets of registers
285
286 -- These are used for dataflow facts, and a common operation is taking
287 -- the union of two RegSets and then asking whether the union is the
288 -- same as one of the inputs. UniqSet isn't good here, because
289 -- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
290 -- Sets.
291
292 type RegSet r = Set r
293 type LocalRegSet = RegSet LocalReg
294 type GlobalRegSet = RegSet GlobalReg
295
296 emptyRegSet :: RegSet r
297 nullRegSet :: RegSet r -> Bool
298 elemRegSet :: Ord r => r -> RegSet r -> Bool
299 extendRegSet :: Ord r => RegSet r -> r -> RegSet r
300 deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
301 mkRegSet :: Ord r => [r] -> RegSet r
302 minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
303 sizeRegSet :: RegSet r -> Int
304 regSetToList :: RegSet r -> [r]
305
306 emptyRegSet = Set.empty
307 nullRegSet = Set.null
308 elemRegSet = Set.member
309 extendRegSet = flip Set.insert
310 deleteFromRegSet = flip Set.delete
311 mkRegSet = Set.fromList
312 minusRegSet = Set.difference
313 plusRegSet = Set.union
314 timesRegSet = Set.intersection
315 sizeRegSet = Set.size
316 regSetToList = Set.toList
317
318 class Ord r => UserOfRegs r a where
319 foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
320
321 foldLocalRegsUsed :: UserOfRegs LocalReg a
322 => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
323 foldLocalRegsUsed = foldRegsUsed
324
325 class Ord r => DefinerOfRegs r a where
326 foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b
327
328 foldLocalRegsDefd :: DefinerOfRegs LocalReg a
329 => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
330 foldLocalRegsDefd = foldRegsDefd
331
332 instance UserOfRegs LocalReg CmmReg where
333 foldRegsUsed _ f z (CmmLocal reg) = f z reg
334 foldRegsUsed _ _ z (CmmGlobal _) = z
335
336 instance DefinerOfRegs LocalReg CmmReg where
337 foldRegsDefd _ f z (CmmLocal reg) = f z reg
338 foldRegsDefd _ _ z (CmmGlobal _) = z
339
340 instance UserOfRegs GlobalReg CmmReg where
341 foldRegsUsed _ _ z (CmmLocal _) = z
342 foldRegsUsed _ f z (CmmGlobal reg) = f z reg
343
344 instance DefinerOfRegs GlobalReg CmmReg where
345 foldRegsDefd _ _ z (CmmLocal _) = z
346 foldRegsDefd _ f z (CmmGlobal reg) = f z reg
347
348 instance Ord r => UserOfRegs r r where
349 foldRegsUsed _ f z r = f z r
350
351 instance Ord r => DefinerOfRegs r r where
352 foldRegsDefd _ f z r = f z r
353
354 instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
355 -- The (Ord r) in the context is necessary here
356 -- See Note [Recursive superclasses] in TcInstDcls
357 foldRegsUsed dflags f !z e = expr z e
358 where expr z (CmmLit _) = z
359 expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr
360 expr z (CmmReg r) = foldRegsUsed dflags f z r
361 expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
362 expr z (CmmRegOff r _) = foldRegsUsed dflags f z r
363 expr z (CmmStackSlot _ _) = z
364
365 instance UserOfRegs r a => UserOfRegs r [a] where
366 foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as
367 {-# INLINABLE foldRegsUsed #-}
368
369 instance DefinerOfRegs r a => DefinerOfRegs r [a] where
370 foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as
371 {-# INLINABLE foldRegsDefd #-}
372
373 -----------------------------------------------------------------------------
374 -- Global STG registers
375 -----------------------------------------------------------------------------
376
377 data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
378
379 -----------------------------------------------------------------------------
380 -- Global STG registers
381 -----------------------------------------------------------------------------
382 {-
383 Note [Overlapping global registers]
384
385 The backend might not faithfully implement the abstraction of the STG
386 machine with independent registers for different values of type
387 GlobalReg. Specifically, certain pairs of registers (r1, r2) may
388 overlap in the sense that a store to r1 invalidates the value in r2,
389 and vice versa.
390
391 Currently this occurs only on the x86_64 architecture where FloatReg n
392 and DoubleReg n are assigned the same microarchitectural register, in
393 order to allow functions to receive more Float# or Double# arguments
394 in registers (as opposed to on the stack).
395
396 There are no specific rules about which registers might overlap with
397 which other registers, but presumably it's safe to assume that nothing
398 will overlap with special registers like Sp or BaseReg.
399
400 Use CmmUtils.regsOverlap to determine whether two GlobalRegs overlap
401 on a particular platform. The instance Eq GlobalReg is syntactic
402 equality of STG registers and does not take overlap into
403 account. However it is still used in UserOfRegs/DefinerOfRegs and
404 there are likely still bugs there, beware!
405 -}
406
407 data GlobalReg
408 -- Argument and return registers
409 = VanillaReg -- pointers, unboxed ints and chars
410 {-# UNPACK #-} !Int -- its number
411 VGcPtr
412
413 | FloatReg -- single-precision floating-point registers
414 {-# UNPACK #-} !Int -- its number
415
416 | DoubleReg -- double-precision floating-point registers
417 {-# UNPACK #-} !Int -- its number
418
419 | LongReg -- long int registers (64-bit, really)
420 {-# UNPACK #-} !Int -- its number
421
422 | XmmReg -- 128-bit SIMD vector register
423 {-# UNPACK #-} !Int -- its number
424
425 | YmmReg -- 256-bit SIMD vector register
426 {-# UNPACK #-} !Int -- its number
427
428 | ZmmReg -- 512-bit SIMD vector register
429 {-# UNPACK #-} !Int -- its number
430
431 -- STG registers
432 | Sp -- Stack ptr; points to last occupied stack location.
433 | SpLim -- Stack limit
434 | Hp -- Heap ptr; points to last occupied heap location.
435 | HpLim -- Heap limit register
436 | CCCS -- Current cost-centre stack
437 | CurrentTSO -- pointer to current thread's TSO
438 | CurrentNursery -- pointer to allocation area
439 | HpAlloc -- allocation count for heap check failure
440
441 -- We keep the address of some commonly-called
442 -- functions in the register table, to keep code
443 -- size down:
444 | EagerBlackholeInfo -- stg_EAGER_BLACKHOLE_info
445 | GCEnter1 -- stg_gc_enter_1
446 | GCFun -- stg_gc_fun
447
448 -- Base offset for the register table, used for accessing registers
449 -- which do not have real registers assigned to them. This register
450 -- will only appear after we have expanded GlobalReg into memory accesses
451 -- (where necessary) in the native code generator.
452 | BaseReg
453
454 -- The register used by the platform for the C stack pointer. This is
455 -- a break in the STG abstraction used exclusively to setup stack unwinding
456 -- information.
457 | MachSp
458
459 -- The is a dummy register used to indicate to the stack unwinder where
460 -- a routine would return to.
461 | UnwindReturnReg
462
463 -- Base Register for PIC (position-independent code) calculations
464 -- Only used inside the native code generator. It's exact meaning differs
465 -- from platform to platform (see module PositionIndependentCode).
466 | PicBaseReg
467
468 deriving( Show )
469
470 instance Eq GlobalReg where
471 VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
472 FloatReg i == FloatReg j = i==j
473 DoubleReg i == DoubleReg j = i==j
474 LongReg i == LongReg j = i==j
475 XmmReg i == XmmReg j = i==j
476 YmmReg i == YmmReg j = i==j
477 ZmmReg i == ZmmReg j = i==j
478 Sp == Sp = True
479 SpLim == SpLim = True
480 Hp == Hp = True
481 HpLim == HpLim = True
482 CCCS == CCCS = True
483 CurrentTSO == CurrentTSO = True
484 CurrentNursery == CurrentNursery = True
485 HpAlloc == HpAlloc = True
486 EagerBlackholeInfo == EagerBlackholeInfo = True
487 GCEnter1 == GCEnter1 = True
488 GCFun == GCFun = True
489 BaseReg == BaseReg = True
490 MachSp == MachSp = True
491 UnwindReturnReg == UnwindReturnReg = True
492 PicBaseReg == PicBaseReg = True
493 _r1 == _r2 = False
494
495 instance Ord GlobalReg where
496 compare (VanillaReg i _) (VanillaReg j _) = compare i j
497 -- Ignore type when seeking clashes
498 compare (FloatReg i) (FloatReg j) = compare i j
499 compare (DoubleReg i) (DoubleReg j) = compare i j
500 compare (LongReg i) (LongReg j) = compare i j
501 compare (XmmReg i) (XmmReg j) = compare i j
502 compare (YmmReg i) (YmmReg j) = compare i j
503 compare (ZmmReg i) (ZmmReg j) = compare i j
504 compare Sp Sp = EQ
505 compare SpLim SpLim = EQ
506 compare Hp Hp = EQ
507 compare HpLim HpLim = EQ
508 compare CCCS CCCS = EQ
509 compare CurrentTSO CurrentTSO = EQ
510 compare CurrentNursery CurrentNursery = EQ
511 compare HpAlloc HpAlloc = EQ
512 compare EagerBlackholeInfo EagerBlackholeInfo = EQ
513 compare GCEnter1 GCEnter1 = EQ
514 compare GCFun GCFun = EQ
515 compare BaseReg BaseReg = EQ
516 compare MachSp MachSp = EQ
517 compare UnwindReturnReg UnwindReturnReg = EQ
518 compare PicBaseReg PicBaseReg = EQ
519 compare (VanillaReg _ _) _ = LT
520 compare _ (VanillaReg _ _) = GT
521 compare (FloatReg _) _ = LT
522 compare _ (FloatReg _) = GT
523 compare (DoubleReg _) _ = LT
524 compare _ (DoubleReg _) = GT
525 compare (LongReg _) _ = LT
526 compare _ (LongReg _) = GT
527 compare (XmmReg _) _ = LT
528 compare _ (XmmReg _) = GT
529 compare (YmmReg _) _ = LT
530 compare _ (YmmReg _) = GT
531 compare (ZmmReg _) _ = LT
532 compare _ (ZmmReg _) = GT
533 compare Sp _ = LT
534 compare _ Sp = GT
535 compare SpLim _ = LT
536 compare _ SpLim = GT
537 compare Hp _ = LT
538 compare _ Hp = GT
539 compare HpLim _ = LT
540 compare _ HpLim = GT
541 compare CCCS _ = LT
542 compare _ CCCS = GT
543 compare CurrentTSO _ = LT
544 compare _ CurrentTSO = GT
545 compare CurrentNursery _ = LT
546 compare _ CurrentNursery = GT
547 compare HpAlloc _ = LT
548 compare _ HpAlloc = GT
549 compare GCEnter1 _ = LT
550 compare _ GCEnter1 = GT
551 compare GCFun _ = LT
552 compare _ GCFun = GT
553 compare BaseReg _ = LT
554 compare _ BaseReg = GT
555 compare MachSp _ = LT
556 compare _ MachSp = GT
557 compare UnwindReturnReg _ = LT
558 compare _ UnwindReturnReg = GT
559 compare EagerBlackholeInfo _ = LT
560 compare _ EagerBlackholeInfo = GT
561
562 -- convenient aliases
563 baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
564 currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: CmmReg
565 baseReg = CmmGlobal BaseReg
566 spReg = CmmGlobal Sp
567 hpReg = CmmGlobal Hp
568 hpLimReg = CmmGlobal HpLim
569 spLimReg = CmmGlobal SpLim
570 nodeReg = CmmGlobal node
571 currentTSOReg = CmmGlobal CurrentTSO
572 currentNurseryReg = CmmGlobal CurrentNursery
573 hpAllocReg = CmmGlobal HpAlloc
574 cccsReg = CmmGlobal CCCS
575
576 node :: GlobalReg
577 node = VanillaReg 1 VGcPtr
578
579 globalRegType :: DynFlags -> GlobalReg -> CmmType
580 globalRegType dflags (VanillaReg _ VGcPtr) = gcWord dflags
581 globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
582 globalRegType _ (FloatReg _) = cmmFloat W32
583 globalRegType _ (DoubleReg _) = cmmFloat W64
584 globalRegType _ (LongReg _) = cmmBits W64
585 globalRegType _ (XmmReg _) = cmmVec 4 (cmmBits W32)
586 globalRegType _ (YmmReg _) = cmmVec 8 (cmmBits W32)
587 globalRegType _ (ZmmReg _) = cmmVec 16 (cmmBits W32)
588
589 globalRegType dflags Hp = gcWord dflags
590 -- The initialiser for all
591 -- dynamically allocated closures
592 globalRegType dflags _ = bWord dflags
593
594 isArgReg :: GlobalReg -> Bool
595 isArgReg (VanillaReg {}) = True
596 isArgReg (FloatReg {}) = True
597 isArgReg (DoubleReg {}) = True
598 isArgReg (LongReg {}) = True
599 isArgReg (XmmReg {}) = True
600 isArgReg (YmmReg {}) = True
601 isArgReg (ZmmReg {}) = True
602 isArgReg _ = False