{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module GHC.Cmm.Reg
    ( -- * Cmm Registers
      CmmReg(..)
    , cmmRegType
    , cmmRegWidth
      -- * Local registers
    , LocalReg(..)
    , localRegType
      -- * Global registers
    , GlobalReg(..), isArgReg, globalRegType
    , pprGlobalReg
    , spReg, hpReg, spLimReg, hpLimReg, nodeReg
    , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
    , node, baseReg
    , VGcPtr(..)
    ) where

import GHC.Prelude

import GHC.Platform
import GHC.Utils.Outputable
import GHC.Types.Unique
import GHC.Cmm.Type

-----------------------------------------------------------------------------
--              Cmm registers
-----------------------------------------------------------------------------

data CmmReg
  = CmmLocal  {-# UNPACK #-} !LocalReg
  | CmmGlobal GlobalReg
  deriving( CmmReg -> CmmReg -> Bool
(CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool) -> Eq CmmReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmReg -> CmmReg -> Bool
== :: CmmReg -> CmmReg -> Bool
$c/= :: CmmReg -> CmmReg -> Bool
/= :: CmmReg -> CmmReg -> Bool
Eq, Eq CmmReg
Eq CmmReg =>
(CmmReg -> CmmReg -> Ordering)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> CmmReg)
-> (CmmReg -> CmmReg -> CmmReg)
-> Ord CmmReg
CmmReg -> CmmReg -> Bool
CmmReg -> CmmReg -> Ordering
CmmReg -> CmmReg -> CmmReg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CmmReg -> CmmReg -> Ordering
compare :: CmmReg -> CmmReg -> Ordering
$c< :: CmmReg -> CmmReg -> Bool
< :: CmmReg -> CmmReg -> Bool
$c<= :: CmmReg -> CmmReg -> Bool
<= :: CmmReg -> CmmReg -> Bool
$c> :: CmmReg -> CmmReg -> Bool
> :: CmmReg -> CmmReg -> Bool
$c>= :: CmmReg -> CmmReg -> Bool
>= :: CmmReg -> CmmReg -> Bool
$cmax :: CmmReg -> CmmReg -> CmmReg
max :: CmmReg -> CmmReg -> CmmReg
$cmin :: CmmReg -> CmmReg -> CmmReg
min :: CmmReg -> CmmReg -> CmmReg
Ord, Int -> CmmReg -> ShowS
[CmmReg] -> ShowS
CmmReg -> String
(Int -> CmmReg -> ShowS)
-> (CmmReg -> String) -> ([CmmReg] -> ShowS) -> Show CmmReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmReg -> ShowS
showsPrec :: Int -> CmmReg -> ShowS
$cshow :: CmmReg -> String
show :: CmmReg -> String
$cshowList :: [CmmReg] -> ShowS
showList :: [CmmReg] -> ShowS
Show )

instance Outputable CmmReg where
    ppr :: CmmReg -> SDoc
ppr CmmReg
e = CmmReg -> SDoc
pprReg CmmReg
e

pprReg :: CmmReg -> SDoc
pprReg :: CmmReg -> SDoc
pprReg CmmReg
r
   = case CmmReg
r of
        CmmLocal  LocalReg
local  -> LocalReg -> SDoc
pprLocalReg  LocalReg
local
        CmmGlobal GlobalReg
global -> GlobalReg -> SDoc
forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
global

cmmRegType :: Platform -> CmmReg -> CmmType
cmmRegType :: Platform -> CmmReg -> CmmType
cmmRegType Platform
_        (CmmLocal  LocalReg
reg) = LocalReg -> CmmType
localRegType LocalReg
reg
cmmRegType Platform
platform (CmmGlobal GlobalReg
reg) = Platform -> GlobalReg -> CmmType
globalRegType Platform
platform GlobalReg
reg

cmmRegWidth :: Platform -> CmmReg -> Width
cmmRegWidth :: Platform -> CmmReg -> Width
cmmRegWidth Platform
platform = CmmType -> Width
typeWidth (CmmType -> Width) -> (CmmReg -> CmmType) -> CmmReg -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmReg -> CmmType
cmmRegType Platform
platform


-----------------------------------------------------------------------------
--              Local registers
-----------------------------------------------------------------------------

data LocalReg
  = LocalReg {-# UNPACK #-} !Unique !CmmType
    -- ^ Parameters:
    --   1. Identifier
    --   2. Type
  deriving Int -> LocalReg -> ShowS
[LocalReg] -> ShowS
LocalReg -> String
(Int -> LocalReg -> ShowS)
-> (LocalReg -> String) -> ([LocalReg] -> ShowS) -> Show LocalReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalReg -> ShowS
showsPrec :: Int -> LocalReg -> ShowS
$cshow :: LocalReg -> String
show :: LocalReg -> String
$cshowList :: [LocalReg] -> ShowS
showList :: [LocalReg] -> ShowS
Show

instance Eq LocalReg where
  (LocalReg Unique
u1 CmmType
_) == :: LocalReg -> LocalReg -> Bool
== (LocalReg Unique
u2 CmmType
_) = Unique
u1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
u2

instance Outputable LocalReg where
    ppr :: LocalReg -> SDoc
ppr LocalReg
e = LocalReg -> SDoc
pprLocalReg LocalReg
e

-- This is non-deterministic but we do not currently support deterministic
-- code-generation. See Note [Unique Determinism and code generation]
-- See Note [No Ord for Unique]
instance Ord LocalReg where
  compare :: LocalReg -> LocalReg -> Ordering
compare (LocalReg Unique
u1 CmmType
_) (LocalReg Unique
u2 CmmType
_) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2

instance Uniquable LocalReg where
  getUnique :: LocalReg -> Unique
getUnique (LocalReg Unique
uniq CmmType
_) = Unique
uniq

localRegType :: LocalReg -> CmmType
localRegType :: LocalReg -> CmmType
localRegType (LocalReg Unique
_ CmmType
rep) = CmmType
rep

--
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg Unique
uniq CmmType
rep) =
--   = ppr rep <> char '_' <> ppr uniq
-- Temp Jan08
    Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall {a}. Outputable a => a -> SDoc
pprUnique Unique
uniq SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
       (if CmmType -> Bool
isWord32 CmmType
rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
                    then SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ptr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmType -> SDoc
forall {a}. Outputable a => a -> SDoc
ppr CmmType
rep
                    else SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ptr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmType -> SDoc
forall {a}. Outputable a => a -> SDoc
ppr CmmType
rep)
   where
     pprUnique :: a -> SDoc
pprUnique a
unique = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressUniques ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
       Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_locVar_"
       Bool
False -> a -> SDoc
forall {a}. Outputable a => a -> SDoc
ppr a
unique
     ptr :: SDoc
ptr = SDoc
forall doc. IsOutput doc => doc
empty
         --if isGcPtrType rep
         --      then doubleQuotes (text "ptr")
         --      else empty

-----------------------------------------------------------------------------
--              Global STG registers
-----------------------------------------------------------------------------
{-
Note [Overlapping global registers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The backend might not faithfully implement the abstraction of the STG
machine with independent registers for different values of type
GlobalReg. Specifically, certain pairs of registers (r1, r2) may
overlap in the sense that a store to r1 invalidates the value in r2,
and vice versa.

Currently this occurs only on the x86_64 architecture where FloatReg n
and DoubleReg n are assigned the same microarchitectural register, in
order to allow functions to receive more Float# or Double# arguments
in registers (as opposed to on the stack).

There are no specific rules about which registers might overlap with
which other registers, but presumably it's safe to assume that nothing
will overlap with special registers like Sp or BaseReg.

Use GHC.Cmm.Utils.regsOverlap to determine whether two GlobalRegs overlap
on a particular platform. The instance Eq GlobalReg is syntactic
equality of STG registers and does not take overlap into
account. However it is still used in UserOfRegs/DefinerOfRegs and
there are likely still bugs there, beware!
-}

data VGcPtr = VGcPtr | VNonGcPtr deriving( VGcPtr -> VGcPtr -> Bool
(VGcPtr -> VGcPtr -> Bool)
-> (VGcPtr -> VGcPtr -> Bool) -> Eq VGcPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VGcPtr -> VGcPtr -> Bool
== :: VGcPtr -> VGcPtr -> Bool
$c/= :: VGcPtr -> VGcPtr -> Bool
/= :: VGcPtr -> VGcPtr -> Bool
Eq, Int -> VGcPtr -> ShowS
[VGcPtr] -> ShowS
VGcPtr -> String
(Int -> VGcPtr -> ShowS)
-> (VGcPtr -> String) -> ([VGcPtr] -> ShowS) -> Show VGcPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VGcPtr -> ShowS
showsPrec :: Int -> VGcPtr -> ShowS
$cshow :: VGcPtr -> String
show :: VGcPtr -> String
$cshowList :: [VGcPtr] -> ShowS
showList :: [VGcPtr] -> ShowS
Show )

data GlobalReg
  -- Argument and return registers
  = VanillaReg                  -- pointers, unboxed ints and chars
        {-# UNPACK #-} !Int     -- its number
        VGcPtr

  | FloatReg            -- single-precision floating-point registers
        {-# UNPACK #-} !Int     -- its number

  | DoubleReg           -- double-precision floating-point registers
        {-# UNPACK #-} !Int     -- its number

  | LongReg             -- long int registers (64-bit, really)
        {-# UNPACK #-} !Int     -- its number

  | XmmReg                      -- 128-bit SIMD vector register
        {-# UNPACK #-} !Int     -- its number

  | YmmReg                      -- 256-bit SIMD vector register
        {-# UNPACK #-} !Int     -- its number

  | ZmmReg                      -- 512-bit SIMD vector register
        {-# UNPACK #-} !Int     -- its number

  -- STG registers
  | Sp                  -- Stack ptr; points to last occupied stack location.
  | SpLim               -- Stack limit
  | Hp                  -- Heap ptr; points to last occupied heap location.
  | HpLim               -- Heap limit register
  | CCCS                -- Current cost-centre stack
  | CurrentTSO          -- pointer to current thread's TSO
  | CurrentNursery      -- pointer to allocation area
  | HpAlloc             -- allocation count for heap check failure

                -- We keep the address of some commonly-called
                -- functions in the register table, to keep code
                -- size down:
  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
  | GCEnter1            -- stg_gc_enter_1
  | GCFun               -- stg_gc_fun

  -- Base offset for the register table, used for accessing registers
  -- which do not have real registers assigned to them.  This register
  -- will only appear after we have expanded GlobalReg into memory accesses
  -- (where necessary) in the native code generator.
  | BaseReg

  -- The register used by the platform for the C stack pointer. This is
  -- a break in the STG abstraction used exclusively to setup stack unwinding
  -- information.
  | MachSp

  -- The is a dummy register used to indicate to the stack unwinder where
  -- a routine would return to.
  | UnwindReturnReg

  -- Base Register for PIC (position-independent code) calculations
  -- Only used inside the native code generator. It's exact meaning differs
  -- from platform to platform (see module PositionIndependentCode).
  | PicBaseReg

  deriving( Int -> GlobalReg -> ShowS
[GlobalReg] -> ShowS
GlobalReg -> String
(Int -> GlobalReg -> ShowS)
-> (GlobalReg -> String)
-> ([GlobalReg] -> ShowS)
-> Show GlobalReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalReg -> ShowS
showsPrec :: Int -> GlobalReg -> ShowS
$cshow :: GlobalReg -> String
show :: GlobalReg -> String
$cshowList :: [GlobalReg] -> ShowS
showList :: [GlobalReg] -> ShowS
Show )

instance Eq GlobalReg where
   VanillaReg Int
i VGcPtr
_ == :: GlobalReg -> GlobalReg -> Bool
== VanillaReg Int
j VGcPtr
_ = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j -- Ignore type when seeking clashes
   FloatReg Int
i == FloatReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   DoubleReg Int
i == DoubleReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   LongReg Int
i == LongReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   -- NOTE: XMM, YMM, ZMM registers actually are the same registers
   -- at least with respect to store at YMM i and then read from XMM i
   -- and similarly for ZMM etc.
   XmmReg Int
i == XmmReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   YmmReg Int
i == YmmReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   ZmmReg Int
i == ZmmReg Int
j = Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j
   GlobalReg
Sp == GlobalReg
Sp = Bool
True
   GlobalReg
SpLim == GlobalReg
SpLim = Bool
True
   GlobalReg
Hp == GlobalReg
Hp = Bool
True
   GlobalReg
HpLim == GlobalReg
HpLim = Bool
True
   GlobalReg
CCCS == GlobalReg
CCCS = Bool
True
   GlobalReg
CurrentTSO == GlobalReg
CurrentTSO = Bool
True
   GlobalReg
CurrentNursery == GlobalReg
CurrentNursery = Bool
True
   GlobalReg
HpAlloc == GlobalReg
HpAlloc = Bool
True
   GlobalReg
EagerBlackholeInfo == GlobalReg
EagerBlackholeInfo = Bool
True
   GlobalReg
GCEnter1 == GlobalReg
GCEnter1 = Bool
True
   GlobalReg
GCFun == GlobalReg
GCFun = Bool
True
   GlobalReg
BaseReg == GlobalReg
BaseReg = Bool
True
   GlobalReg
MachSp == GlobalReg
MachSp = Bool
True
   GlobalReg
UnwindReturnReg == GlobalReg
UnwindReturnReg = Bool
True
   GlobalReg
PicBaseReg == GlobalReg
PicBaseReg = Bool
True
   GlobalReg
_r1 == GlobalReg
_r2 = Bool
False

-- NOTE: this Ord instance affects the tuple layout in GHCi, see
--       Note [GHCi and native call registers]
instance Ord GlobalReg where
   compare :: GlobalReg -> GlobalReg -> Ordering
compare (VanillaReg Int
i VGcPtr
_) (VanillaReg Int
j VGcPtr
_) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
     -- Ignore type when seeking clashes
   compare (FloatReg Int
i)  (FloatReg  Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare (DoubleReg Int
i) (DoubleReg Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare (LongReg Int
i)   (LongReg   Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare (XmmReg Int
i)    (XmmReg    Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare (YmmReg Int
i)    (YmmReg    Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare (ZmmReg Int
i)    (ZmmReg    Int
j) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
j
   compare GlobalReg
Sp GlobalReg
Sp = Ordering
EQ
   compare GlobalReg
SpLim GlobalReg
SpLim = Ordering
EQ
   compare GlobalReg
Hp GlobalReg
Hp = Ordering
EQ
   compare GlobalReg
HpLim GlobalReg
HpLim = Ordering
EQ
   compare GlobalReg
CCCS GlobalReg
CCCS = Ordering
EQ
   compare GlobalReg
CurrentTSO GlobalReg
CurrentTSO = Ordering
EQ
   compare GlobalReg
CurrentNursery GlobalReg
CurrentNursery = Ordering
EQ
   compare GlobalReg
HpAlloc GlobalReg
HpAlloc = Ordering
EQ
   compare GlobalReg
EagerBlackholeInfo GlobalReg
EagerBlackholeInfo = Ordering
EQ
   compare GlobalReg
GCEnter1 GlobalReg
GCEnter1 = Ordering
EQ
   compare GlobalReg
GCFun GlobalReg
GCFun = Ordering
EQ
   compare GlobalReg
BaseReg GlobalReg
BaseReg = Ordering
EQ
   compare GlobalReg
MachSp GlobalReg
MachSp = Ordering
EQ
   compare GlobalReg
UnwindReturnReg GlobalReg
UnwindReturnReg = Ordering
EQ
   compare GlobalReg
PicBaseReg GlobalReg
PicBaseReg = Ordering
EQ
   compare (VanillaReg Int
_ VGcPtr
_) GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ (VanillaReg Int
_ VGcPtr
_) = Ordering
GT
   compare (FloatReg Int
_) GlobalReg
_     = Ordering
LT
   compare GlobalReg
_ (FloatReg Int
_)     = Ordering
GT
   compare (DoubleReg Int
_) GlobalReg
_    = Ordering
LT
   compare GlobalReg
_ (DoubleReg Int
_)    = Ordering
GT
   compare (LongReg Int
_) GlobalReg
_      = Ordering
LT
   compare GlobalReg
_ (LongReg Int
_)      = Ordering
GT
   compare (XmmReg Int
_) GlobalReg
_       = Ordering
LT
   compare GlobalReg
_ (XmmReg Int
_)       = Ordering
GT
   compare (YmmReg Int
_) GlobalReg
_       = Ordering
LT
   compare GlobalReg
_ (YmmReg Int
_)       = Ordering
GT
   compare (ZmmReg Int
_) GlobalReg
_       = Ordering
LT
   compare GlobalReg
_ (ZmmReg Int
_)       = Ordering
GT
   compare GlobalReg
Sp GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
Sp = Ordering
GT
   compare GlobalReg
SpLim GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
SpLim = Ordering
GT
   compare GlobalReg
Hp GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
Hp = Ordering
GT
   compare GlobalReg
HpLim GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
HpLim = Ordering
GT
   compare GlobalReg
CCCS GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
CCCS = Ordering
GT
   compare GlobalReg
CurrentTSO GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
CurrentTSO = Ordering
GT
   compare GlobalReg
CurrentNursery GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
CurrentNursery = Ordering
GT
   compare GlobalReg
HpAlloc GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
HpAlloc = Ordering
GT
   compare GlobalReg
GCEnter1 GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
GCEnter1 = Ordering
GT
   compare GlobalReg
GCFun GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
GCFun = Ordering
GT
   compare GlobalReg
BaseReg GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
BaseReg = Ordering
GT
   compare GlobalReg
MachSp GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
MachSp = Ordering
GT
   compare GlobalReg
UnwindReturnReg GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
UnwindReturnReg = Ordering
GT
   compare GlobalReg
EagerBlackholeInfo GlobalReg
_ = Ordering
LT
   compare GlobalReg
_ GlobalReg
EagerBlackholeInfo = Ordering
GT

instance Outputable GlobalReg where
    ppr :: GlobalReg -> SDoc
ppr GlobalReg
e = GlobalReg -> SDoc
forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
e

instance OutputableP env GlobalReg where
    pdoc :: env -> GlobalReg -> SDoc
pdoc env
_ = GlobalReg -> SDoc
forall {a}. Outputable a => a -> SDoc
ppr

pprGlobalReg :: IsLine doc => GlobalReg -> doc
pprGlobalReg :: forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
gr
    = case GlobalReg
gr of
        VanillaReg Int
n VGcPtr
_ -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'R' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
-- Temp Jan08
--        VanillaReg n VNonGcPtr -> char 'R' <> int n
--        VanillaReg n VGcPtr    -> char 'P' <> int n
        FloatReg   Int
n   -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'F' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        DoubleReg  Int
n   -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'D' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        LongReg    Int
n   -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        XmmReg     Int
n   -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"XMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        YmmReg     Int
n   -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"YMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        ZmmReg     Int
n   -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ZMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
        GlobalReg
Sp             -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"Sp"
        GlobalReg
SpLim          -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"SpLim"
        GlobalReg
Hp             -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"Hp"
        GlobalReg
HpLim          -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"HpLim"
        GlobalReg
MachSp         -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"MachSp"
        GlobalReg
UnwindReturnReg-> String -> doc
forall doc. IsLine doc => String -> doc
text String
"UnwindReturnReg"
        GlobalReg
CCCS           -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CCCS"
        GlobalReg
CurrentTSO     -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CurrentTSO"
        GlobalReg
CurrentNursery -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CurrentNursery"
        GlobalReg
HpAlloc        -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"HpAlloc"
        GlobalReg
EagerBlackholeInfo -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_EAGER_BLACKHOLE_info"
        GlobalReg
GCEnter1       -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_gc_enter_1"
        GlobalReg
GCFun          -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_gc_fun"
        GlobalReg
BaseReg        -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"BaseReg"
        GlobalReg
PicBaseReg     -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"PicBaseReg"
{-# SPECIALIZE pprGlobalReg :: GlobalReg -> SDoc #-}
{-# SPECIALIZE pprGlobalReg :: GlobalReg -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable


-- convenient aliases
baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
  currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg  :: CmmReg
baseReg :: CmmReg
baseReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
BaseReg
spReg :: CmmReg
spReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
Sp
hpReg :: CmmReg
hpReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
Hp
hpLimReg :: CmmReg
hpLimReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
HpLim
spLimReg :: CmmReg
spLimReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
SpLim
nodeReg :: CmmReg
nodeReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
node
currentTSOReg :: CmmReg
currentTSOReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
CurrentTSO
currentNurseryReg :: CmmReg
currentNurseryReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
CurrentNursery
hpAllocReg :: CmmReg
hpAllocReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
HpAlloc
cccsReg :: CmmReg
cccsReg = GlobalReg -> CmmReg
CmmGlobal GlobalReg
CCCS

node :: GlobalReg
node :: GlobalReg
node = Int -> VGcPtr -> GlobalReg
VanillaReg Int
1 VGcPtr
VGcPtr

globalRegType :: Platform -> GlobalReg -> CmmType
globalRegType :: Platform -> GlobalReg -> CmmType
globalRegType Platform
platform = \case
   (VanillaReg Int
_ VGcPtr
VGcPtr)    -> Platform -> CmmType
gcWord Platform
platform
   (VanillaReg Int
_ VGcPtr
VNonGcPtr) -> Platform -> CmmType
bWord Platform
platform
   (FloatReg Int
_)             -> Width -> CmmType
cmmFloat Width
W32
   (DoubleReg Int
_)            -> Width -> CmmType
cmmFloat Width
W64
   (LongReg Int
_)              -> Width -> CmmType
cmmBits Width
W64
   -- TODO: improve the internal model of SIMD/vectorized registers
   -- the right design SHOULd improve handling of float and double code too.
   -- see remarks in Note [SIMD Design for the future] in GHC.StgToCmm.Prim
   (XmmReg Int
_) -> Int -> CmmType -> CmmType
cmmVec Int
4 (Width -> CmmType
cmmBits Width
W32)
   (YmmReg Int
_) -> Int -> CmmType -> CmmType
cmmVec Int
8 (Width -> CmmType
cmmBits Width
W32)
   (ZmmReg Int
_) -> Int -> CmmType -> CmmType
cmmVec Int
16 (Width -> CmmType
cmmBits Width
W32)

   GlobalReg
Hp         -> Platform -> CmmType
gcWord Platform
platform -- The initialiser for all
                                 -- dynamically allocated closures
   GlobalReg
_          -> Platform -> CmmType
bWord Platform
platform

isArgReg :: GlobalReg -> Bool
isArgReg :: GlobalReg -> Bool
isArgReg (VanillaReg {}) = Bool
True
isArgReg (FloatReg {})   = Bool
True
isArgReg (DoubleReg {})  = Bool
True
isArgReg (LongReg {})    = Bool
True
isArgReg (XmmReg {})     = Bool
True
isArgReg (YmmReg {})     = Bool
True
isArgReg (ZmmReg {})     = Bool
True
isArgReg GlobalReg
_               = Bool
False