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