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