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