    {-# 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