1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE UndecidableInstances #-}
6
7module 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    )
31where
32
33import GhcPrelude
34
35import BlockId
36import CLabel
37import CmmMachOp
38import CmmType
39import DynFlags
40import Outputable (panic)
41import Unique
42
43import Data.Set (Set)
44import qualified Data.Set as Set
45
46import BasicTypes (Alignment, mkAlignment, alignmentOf)
47
48-----------------------------------------------------------------------------
49--              CmmExpr
50-- An expression.  Expressions have no side effects.
51-----------------------------------------------------------------------------
52
53data 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
67instance 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
76data 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.
83data 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~~~~~~~~~~~~~~~~~~
91There is a single call area 'Old', allocated at the extreme old
92end of the stack frame (ie just younger than the return address)
93which holds:
94  * incoming (overflow) parameters,
95  * outgoing (overflow) parameter to tail calls,
96  * outgoing (overflow) result values
97  * the update frame (if any)
98
99Its size is the max of all these requirements.  On entry, the stack
100pointer will point to the youngest incoming parameter, which is not
101necessarily at the young end of the Old area.
102
103End of note -}
104
105
106{- Note [CmmStackSlot aliasing]
107~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
108When 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
113Or more informally, different Areas may overlap with each other.
114
115An alternative semantics, that we previously had, was that different
116Areas do not overlap.  The problem that lead to redefining the
117semantics of stack areas is described below.
118
119e.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
129if 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
136and now young(L) cannot be allocated at the same place as old, and we
137are 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
142so 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
150However, if areas are defined to be "possibly overlapping" in the
151semantics, then we cannot commute any loads/stores of old with
152young(L), and we will be able to re-use both old+8 and old+16 for
153young(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
164Now, 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
173data 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
212cmmExprType :: DynFlags -> CmmExpr -> CmmType
213cmmExprType dflags (CmmLit lit)        = cmmLitType dflags lit
214cmmExprType _      (CmmLoad _ rep)     = rep
215cmmExprType dflags (CmmReg reg)        = cmmRegType dflags reg
216cmmExprType dflags (CmmMachOp op args) = machOpResultType dflags op (map (cmmExprType dflags) args)
217cmmExprType dflags (CmmRegOff reg _)   = cmmRegType dflags reg
218cmmExprType dflags (CmmStackSlot _ _)  = bWord dflags -- an address
219-- Careful though: what is stored at the stack slot may be bigger than
220-- an address
221
222cmmLitType :: DynFlags -> CmmLit -> CmmType
223cmmLitType _      (CmmInt _ width)     = cmmBits  width
224cmmLitType _      (CmmFloat _ width)   = cmmFloat width
225cmmLitType _      (CmmVec [])          = panic "cmmLitType: CmmVec []"
226cmmLitType 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"
230cmmLitType dflags (CmmLabel lbl)       = cmmLabelType dflags lbl
231cmmLitType dflags (CmmLabelOff lbl _)  = cmmLabelType dflags lbl
232cmmLitType _      (CmmLabelDiffOff _ _ _ width) = cmmBits width
233cmmLitType dflags (CmmBlock _)         = bWord dflags
234cmmLitType dflags (CmmHighStackMark)   = bWord dflags
235
236cmmLabelType :: DynFlags -> CLabel -> CmmType
237cmmLabelType dflags lbl
238 | isGcPtrLabel lbl = gcWord dflags
239 | otherwise        = bWord dflags
240
241cmmExprWidth :: DynFlags -> CmmExpr -> Width
242cmmExprWidth 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.
248cmmExprAlignment :: CmmExpr -> Alignment
249cmmExprAlignment (CmmLit (CmmInt intOff _)) = alignmentOf (fromInteger intOff)
250cmmExprAlignment _                          = mkAlignment 1
251--------
252--- Negation for conditional branches
253
254maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
255maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
256                                            return (CmmMachOp op' args)
257maybeInvertCmmExpr _ = Nothing
258
259-----------------------------------------------------------------------------
260--              Local registers
261-----------------------------------------------------------------------------
262
263data LocalReg
264  = LocalReg {-# UNPACK #-} !Unique CmmType
265    -- ^ Parameters:
266    --   1. Identifier
267    --   2. Type
268
269instance 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]
275instance Ord LocalReg where
276  compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
277
278instance Uniquable LocalReg where
279  getUnique (LocalReg uniq _) = uniq
280
281cmmRegType :: DynFlags -> CmmReg -> CmmType
282cmmRegType _      (CmmLocal  reg) = localRegType reg
283cmmRegType dflags (CmmGlobal reg) = globalRegType dflags reg
284
285cmmRegWidth :: DynFlags -> CmmReg -> Width
286cmmRegWidth dflags = typeWidth . cmmRegType dflags
287
288localRegType :: LocalReg -> CmmType
289localRegType (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
303type RegSet r     = Set r
304type LocalRegSet  = RegSet LocalReg
305type GlobalRegSet = RegSet GlobalReg
306
307emptyRegSet             :: RegSet r
308nullRegSet              :: RegSet r -> Bool
309elemRegSet              :: Ord r => r -> RegSet r -> Bool
310extendRegSet            :: Ord r => RegSet r -> r -> RegSet r
311deleteFromRegSet        :: Ord r => RegSet r -> r -> RegSet r
312mkRegSet                :: Ord r => [r] -> RegSet r
313minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
314sizeRegSet              :: RegSet r -> Int
315regSetToList            :: RegSet r -> [r]
316
317emptyRegSet      = Set.empty
318nullRegSet       = Set.null
319elemRegSet       = Set.member
320extendRegSet     = flip Set.insert
321deleteFromRegSet = flip Set.delete
322mkRegSet         = Set.fromList
323minusRegSet      = Set.difference
324plusRegSet       = Set.union
325timesRegSet      = Set.intersection
326sizeRegSet       = Set.size
327regSetToList     = Set.toList
328
329class Ord r => UserOfRegs r a where
330  foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
331
332foldLocalRegsUsed :: UserOfRegs LocalReg a
333                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
334foldLocalRegsUsed = foldRegsUsed
335
336class Ord r => DefinerOfRegs r a where
337  foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b
338
339foldLocalRegsDefd :: DefinerOfRegs LocalReg a
340                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
341foldLocalRegsDefd = foldRegsDefd
342
343instance UserOfRegs LocalReg CmmReg where
344    foldRegsUsed _ f z (CmmLocal reg) = f z reg
345    foldRegsUsed _ _ z (CmmGlobal _)  = z
346
347instance DefinerOfRegs LocalReg CmmReg where
348    foldRegsDefd _ f z (CmmLocal reg) = f z reg
349    foldRegsDefd _ _ z (CmmGlobal _)  = z
350
351instance UserOfRegs GlobalReg CmmReg where
352    foldRegsUsed _ _ z (CmmLocal _)    = z
353    foldRegsUsed _ f z (CmmGlobal reg) = f z reg
354
355instance DefinerOfRegs GlobalReg CmmReg where
356    foldRegsDefd _ _ z (CmmLocal _)    = z
357    foldRegsDefd _ f z (CmmGlobal reg) = f z reg
358
359instance Ord r => UserOfRegs r r where
360    foldRegsUsed _ f z r = f z r
361
362instance Ord r => DefinerOfRegs r r where
363    foldRegsDefd _ f z r = f z r
364
365instance (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
376instance UserOfRegs r a => UserOfRegs r [a] where
377  foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as
378  {-# INLINABLE foldRegsUsed #-}
379
380instance 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
388data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
389
390-----------------------------------------------------------------------------
391--              Global STG registers
392-----------------------------------------------------------------------------
393{-
394Note [Overlapping global registers]
395
396The backend might not faithfully implement the abstraction of the STG
397machine with independent registers for different values of type
398GlobalReg. Specifically, certain pairs of registers (r1, r2) may
399overlap in the sense that a store to r1 invalidates the value in r2,
400and vice versa.
401
402Currently this occurs only on the x86_64 architecture where FloatReg n
403and DoubleReg n are assigned the same microarchitectural register, in
404order to allow functions to receive more Float# or Double# arguments
405in registers (as opposed to on the stack).
406
407There are no specific rules about which registers might overlap with
408which other registers, but presumably it's safe to assume that nothing
409will overlap with special registers like Sp or BaseReg.
410
411Use CmmUtils.regsOverlap to determine whether two GlobalRegs overlap
412on a particular platform. The instance Eq GlobalReg is syntactic
413equality of STG registers and does not take overlap into
414account. However it is still used in UserOfRegs/DefinerOfRegs and
415there are likely still bugs there, beware!
416-}
417
418data 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
481instance 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
509instance 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
577baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
578  currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg  :: CmmReg
579baseReg = CmmGlobal BaseReg
580spReg = CmmGlobal Sp
581hpReg = CmmGlobal Hp
582hpLimReg = CmmGlobal HpLim
583spLimReg = CmmGlobal SpLim
584nodeReg = CmmGlobal node
585currentTSOReg = CmmGlobal CurrentTSO
586currentNurseryReg = CmmGlobal CurrentNursery
587hpAllocReg = CmmGlobal HpAlloc
588cccsReg = CmmGlobal CCCS
589
590node :: GlobalReg
591node = VanillaReg 1 VGcPtr
592
593globalRegType :: DynFlags -> GlobalReg -> CmmType
594globalRegType dflags (VanillaReg _ VGcPtr)    = gcWord dflags
595globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
596globalRegType _      (FloatReg _)      = cmmFloat W32
597globalRegType _      (DoubleReg _)     = cmmFloat W64
598globalRegType _      (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 GHC.StgToCmm.Prim
602globalRegType _      (XmmReg _)        = cmmVec 4 (cmmBits W32)
603globalRegType _      (YmmReg _)        = cmmVec 8 (cmmBits W32)
604globalRegType _      (ZmmReg _)        = cmmVec 16 (cmmBits W32)
605
606globalRegType dflags Hp                = gcWord dflags
607                                            -- The initialiser for all
608                                            -- dynamically allocated closures
609globalRegType dflags _                 = bWord dflags
610
611isArgReg :: GlobalReg -> Bool
612isArgReg (VanillaReg {}) = True
613isArgReg (FloatReg {})   = True
614isArgReg (DoubleReg {})  = True
615isArgReg (LongReg {})    = True
616isArgReg (XmmReg {})     = True
617isArgReg (YmmReg {})     = True
618isArgReg (ZmmReg {})     = True
619isArgReg _               = False
620