{-# LANGUAGE MagicHash #-}

-- | An architecture independent description of a register.
--      This needs to stay architecture independent because it is used
--      by NCGMonad and the register allocators, which are shared
--      by all architectures.
--
module GHC.Platform.Reg (
        RegNo,
        Reg(..),
        regSingle,
        realRegSingle,
        isRealReg,      takeRealReg,
        isVirtualReg,   takeVirtualReg,

        VirtualReg(..),
        renameVirtualReg,
        classOfVirtualReg,
        getHiVirtualRegFromLo,
        getHiVRegFromLo,

        RealReg(..),
        regNosOfRealReg,
        realRegsAlias,

        liftPatchFnToRegReg
)

where

import GHC.Prelude
import GHC.Exts ( Int(I#), dataToTag# )

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Platform.Reg.Class
import qualified GHC.Platform.Reg.Class.Unified   as Unified
import qualified GHC.Platform.Reg.Class.Separate  as Separate
import qualified GHC.Platform.Reg.Class.NoVectors as NoVectors
import GHC.Platform.ArchOS

-- | An identifier for a primitive real machine register.
type RegNo
        = Int

-- VirtualRegs are virtual registers.  The register allocator will
--      eventually have to map them into RealRegs, or into spill slots.
--
--      VirtualRegs are allocated on the fly, usually to represent a single
--      value in the abstract assembly code (i.e. dynamic registers are
--      usually single assignment).
--
--      The  single assignment restriction isn't necessary to get correct code,
--      although a better register allocation will result if single
--      assignment is used -- because the allocator maps a VirtualReg into
--      a single RealReg, even if the VirtualReg has multiple live ranges.
--
--      Virtual regs can be of either class, so that info is attached.
--
data VirtualReg
   -- | Integer virtual register
   = VirtualRegI    { VirtualReg -> Unique
virtualRegUnique :: {-# UNPACK #-} !Unique }
   -- | High part of 2-word virtual register
   | VirtualRegHi   { virtualRegUnique :: {-# UNPACK #-} !Unique }
   -- | Double virtual register
   | VirtualRegD    { virtualRegUnique :: {-# UNPACK #-} !Unique }
   -- | 128-bit wide vector virtual register
   | VirtualRegV128 { virtualRegUnique :: {-# UNPACK #-} !Unique }
   deriving (VirtualReg -> VirtualReg -> Bool
(VirtualReg -> VirtualReg -> Bool)
-> (VirtualReg -> VirtualReg -> Bool) -> Eq VirtualReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VirtualReg -> VirtualReg -> Bool
== :: VirtualReg -> VirtualReg -> Bool
$c/= :: VirtualReg -> VirtualReg -> Bool
/= :: VirtualReg -> VirtualReg -> Bool
Eq, RegNo -> VirtualReg -> ShowS
[VirtualReg] -> ShowS
VirtualReg -> String
(RegNo -> VirtualReg -> ShowS)
-> (VirtualReg -> String)
-> ([VirtualReg] -> ShowS)
-> Show VirtualReg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> VirtualReg -> ShowS
showsPrec :: RegNo -> VirtualReg -> ShowS
$cshow :: VirtualReg -> String
show :: VirtualReg -> String
$cshowList :: [VirtualReg] -> ShowS
showList :: [VirtualReg] -> ShowS
Show)

-- We can't derive Ord, because Unique doesn't have an Ord instance.
-- Note nonDetCmpUnique in the implementation. See Note [No Ord for Unique].
-- This is non-deterministic but we do not currently support deterministic
-- code-generation. See Note [Unique Determinism and code generation]
instance Ord VirtualReg where
  compare :: VirtualReg -> VirtualReg -> Ordering
compare VirtualReg
vr1 VirtualReg
vr2 =
    case RegNo -> RegNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> RegNo
I# (VirtualReg -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# VirtualReg
vr1)) (Int# -> RegNo
I# (VirtualReg -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# VirtualReg
vr2)) of
      Ordering
LT -> Ordering
LT
      Ordering
GT -> Ordering
GT
      Ordering
EQ -> Unique -> Unique -> Ordering
nonDetCmpUnique (VirtualReg -> Unique
virtualRegUnique VirtualReg
vr1) (VirtualReg -> Unique
virtualRegUnique VirtualReg
vr2)

instance Uniquable VirtualReg where
        getUnique :: VirtualReg -> Unique
getUnique = VirtualReg -> Unique
virtualRegUnique

instance Outputable VirtualReg where
        ppr :: VirtualReg -> SDoc
ppr VirtualReg
reg
         = case VirtualReg
reg of
                VirtualRegI    Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vI_"   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
                VirtualRegHi   Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vHi_"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
                VirtualRegD    Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vDouble_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
                VirtualRegV128 Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vV128_"   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u


renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg Unique
u VirtualReg
r = VirtualReg
r { virtualRegUnique = u }

classOfVirtualReg :: Arch -> VirtualReg -> RegClass
classOfVirtualReg :: Arch -> VirtualReg -> RegClass
classOfVirtualReg Arch
arch VirtualReg
vr
  = case VirtualReg
vr of
        VirtualRegI{} ->
          case RegArch
regArch of
            RegArch
Unified   ->   RegClass
Unified.RcInteger
            RegArch
Separate  ->  RegClass
Separate.RcInteger
            RegArch
NoVectors -> RegClass
NoVectors.RcInteger
        VirtualRegHi{} ->
          case RegArch
regArch of
            RegArch
Unified   ->   RegClass
Unified.RcInteger
            RegArch
Separate  ->  RegClass
Separate.RcInteger
            RegArch
NoVectors -> RegClass
NoVectors.RcInteger
        VirtualRegD{} ->
          case RegArch
regArch of
            RegArch
Unified   ->   RegClass
Unified.RcFloatOrVector
            RegArch
Separate  ->  RegClass
Separate.RcFloat
            RegArch
NoVectors -> RegClass
NoVectors.RcFloat
        VirtualRegV128{} ->
          case RegArch
regArch of
            RegArch
Unified   ->  RegClass
Unified.RcFloatOrVector
            RegArch
Separate  -> RegClass
Separate.RcVector
            RegArch
NoVectors -> String -> SDoc -> RegClass
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"classOfVirtualReg VirtualRegV128"
                           ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arch:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text ( Arch -> String
forall a. Show a => a -> String
show Arch
arch ) )
  where
    regArch :: RegArch
regArch = Arch -> RegArch
registerArch Arch
arch

-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
-- when supplied with the vreg for the lower-half of the quantity.
-- (NB. Not reversible).
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
reg
 = case VirtualReg
reg of
        -- makes a pseudo-unique with tag 'H'
        VirtualRegI Unique
u   -> Unique -> VirtualReg
VirtualRegHi (Unique -> Char -> Unique
newTagUnique Unique
u Char
'H')
        VirtualReg
_               -> String -> VirtualReg
forall a. HasCallStack => String -> a
panic String
"Reg.getHiVirtualRegFromLo"

getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo Reg
reg
 = case Reg
reg of
        RegVirtual  VirtualReg
vr  -> VirtualReg -> Reg
RegVirtual (VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
vr)
        RegReal RealReg
_       -> String -> Reg
forall a. HasCallStack => String -> a
panic String
"Reg.getHiVRegFromLo"


------------------------------------------------------------------------------------
-- | RealRegs are machine regs which are available for allocation, in
--      the usual way.  We know what class they are, because that's part of
--      the processor's architecture.
--
newtype RealReg
        = RealRegSingle RegNo
        deriving (RealReg -> RealReg -> Bool
(RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool) -> Eq RealReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RealReg -> RealReg -> Bool
== :: RealReg -> RealReg -> Bool
$c/= :: RealReg -> RealReg -> Bool
/= :: RealReg -> RealReg -> Bool
Eq, RegNo -> RealReg -> ShowS
[RealReg] -> ShowS
RealReg -> String
(RegNo -> RealReg -> ShowS)
-> (RealReg -> String) -> ([RealReg] -> ShowS) -> Show RealReg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> RealReg -> ShowS
showsPrec :: RegNo -> RealReg -> ShowS
$cshow :: RealReg -> String
show :: RealReg -> String
$cshowList :: [RealReg] -> ShowS
showList :: [RealReg] -> ShowS
Show, Eq RealReg
Eq RealReg =>
(RealReg -> RealReg -> Ordering)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> RealReg)
-> (RealReg -> RealReg -> RealReg)
-> Ord RealReg
RealReg -> RealReg -> Bool
RealReg -> RealReg -> Ordering
RealReg -> RealReg -> RealReg
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 :: RealReg -> RealReg -> Ordering
compare :: RealReg -> RealReg -> Ordering
$c< :: RealReg -> RealReg -> Bool
< :: RealReg -> RealReg -> Bool
$c<= :: RealReg -> RealReg -> Bool
<= :: RealReg -> RealReg -> Bool
$c> :: RealReg -> RealReg -> Bool
> :: RealReg -> RealReg -> Bool
$c>= :: RealReg -> RealReg -> Bool
>= :: RealReg -> RealReg -> Bool
$cmax :: RealReg -> RealReg -> RealReg
max :: RealReg -> RealReg -> RealReg
$cmin :: RealReg -> RealReg -> RealReg
min :: RealReg -> RealReg -> RealReg
Ord)

instance Uniquable RealReg where
        getUnique :: RealReg -> Unique
getUnique RealReg
reg
         = case RealReg
reg of
                RealRegSingle RegNo
i         -> RegNo -> Unique
mkRegSingleUnique RegNo
i

instance Outputable RealReg where
        ppr :: RealReg -> SDoc
ppr RealReg
reg
         = case RealReg
reg of
                RealRegSingle RegNo
i         -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%r"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int RegNo
i

regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg RealReg
rr
 = case RealReg
rr of
        RealRegSingle RegNo
r1        -> [RegNo
r1]


realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias RealReg
rr1 RealReg
rr2 =
    -- used to be `not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)`
    -- but that resulted in some gnarly, gnarly, allocating code. So we manually
    -- write out all the cases which gives us nice non-allocating code.
    case RealReg
rr1 of
        RealRegSingle RegNo
r1 ->
            case RealReg
rr2 of RealRegSingle RegNo
r2 -> RegNo
r1 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
r2

--------------------------------------------------------------------------------
-- | A register, either virtual or real
data Reg
        = RegVirtual !VirtualReg
        | RegReal    !RealReg
        deriving (Reg -> Reg -> Bool
(Reg -> Reg -> Bool) -> (Reg -> Reg -> Bool) -> Eq Reg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
/= :: Reg -> Reg -> Bool
Eq, Eq Reg
Eq Reg =>
(Reg -> Reg -> Ordering)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Reg)
-> (Reg -> Reg -> Reg)
-> Ord Reg
Reg -> Reg -> Bool
Reg -> Reg -> Ordering
Reg -> Reg -> Reg
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 :: Reg -> Reg -> Ordering
compare :: Reg -> Reg -> Ordering
$c< :: Reg -> Reg -> Bool
< :: Reg -> Reg -> Bool
$c<= :: Reg -> Reg -> Bool
<= :: Reg -> Reg -> Bool
$c> :: Reg -> Reg -> Bool
> :: Reg -> Reg -> Bool
$c>= :: Reg -> Reg -> Bool
>= :: Reg -> Reg -> Bool
$cmax :: Reg -> Reg -> Reg
max :: Reg -> Reg -> Reg
$cmin :: Reg -> Reg -> Reg
min :: Reg -> Reg -> Reg
Ord, RegNo -> Reg -> ShowS
[Reg] -> ShowS
Reg -> String
(RegNo -> Reg -> ShowS)
-> (Reg -> String) -> ([Reg] -> ShowS) -> Show Reg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> Reg -> ShowS
showsPrec :: RegNo -> Reg -> ShowS
$cshow :: Reg -> String
show :: Reg -> String
$cshowList :: [Reg] -> ShowS
showList :: [Reg] -> ShowS
Show)

regSingle :: RegNo -> Reg
regSingle :: RegNo -> Reg
regSingle RegNo
regNo = RealReg -> Reg
RegReal (RegNo -> RealReg
realRegSingle RegNo
regNo)

realRegSingle :: RegNo -> RealReg
realRegSingle :: RegNo -> RealReg
realRegSingle RegNo
regNo = RegNo -> RealReg
RealRegSingle RegNo
regNo


-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets
-- in the register allocator.
instance Uniquable Reg where
        getUnique :: Reg -> Unique
getUnique Reg
reg
         = case Reg
reg of
                RegVirtual VirtualReg
vr   -> VirtualReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique VirtualReg
vr
                RegReal    RealReg
rr   -> RealReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique RealReg
rr

-- | Print a reg in a generic manner
--      If you want the architecture specific names, then use the pprReg
--      function from the appropriate Ppr module.
instance Outputable Reg where
        ppr :: Reg -> SDoc
ppr Reg
reg
         = case Reg
reg of
                RegVirtual VirtualReg
vr   -> VirtualReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr VirtualReg
vr
                RegReal    RealReg
rr   -> RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
rr


isRealReg :: Reg -> Bool
isRealReg :: Reg -> Bool
isRealReg Reg
reg
 = case Reg
reg of
        RegReal RealReg
_       -> Bool
True
        RegVirtual VirtualReg
_    -> Bool
False

takeRealReg :: Reg -> Maybe RealReg
takeRealReg :: Reg -> Maybe RealReg
takeRealReg Reg
reg
 = case Reg
reg of
        RegReal RealReg
rr      -> RealReg -> Maybe RealReg
forall a. a -> Maybe a
Just RealReg
rr
        Reg
_               -> Maybe RealReg
forall a. Maybe a
Nothing


isVirtualReg :: Reg -> Bool
isVirtualReg :: Reg -> Bool
isVirtualReg Reg
reg
 = case Reg
reg of
        RegReal RealReg
_       -> Bool
False
        RegVirtual VirtualReg
_    -> Bool
True

takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg Reg
reg
 = case Reg
reg of
        RegReal RealReg
_       -> Maybe VirtualReg
forall a. Maybe a
Nothing
        RegVirtual VirtualReg
vr   -> VirtualReg -> Maybe VirtualReg
forall a. a -> Maybe a
Just VirtualReg
vr


-- | The patch function supplied by the allocator maps VirtualReg to RealReg
--      regs, but sometimes we want to apply it to plain old Reg.
--
liftPatchFnToRegReg  :: (VirtualReg -> RealReg) -> (Reg -> Reg)
liftPatchFnToRegReg :: (VirtualReg -> RealReg) -> Reg -> Reg
liftPatchFnToRegReg VirtualReg -> RealReg
patchF Reg
reg
 = case Reg
reg of
        RegVirtual VirtualReg
vr   -> RealReg -> Reg
RegReal (VirtualReg -> RealReg
patchF VirtualReg
vr)
        RegReal RealReg
_       -> Reg
reg