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