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