-- | 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 Reg (
        RegNo,
        Reg(..),
        regPair,
        regSingle,
        isRealReg,      takeRealReg,
        isVirtualReg,   takeVirtualReg,

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

        RealReg(..),
        regNosOfRealReg,
        realRegsAlias,

        liftPatchFnToRegReg
)

where

import GhcPrelude

import Outputable
import Unique
import RegClass
import Data.List

-- | 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
        = VirtualRegI  {-# UNPACK #-} !Unique
        | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
        | VirtualRegF  {-# UNPACK #-} !Unique
        | VirtualRegD  {-# UNPACK #-} !Unique
        | VirtualRegSSE {-# UNPACK #-} !Unique
        deriving (VirtualReg -> VirtualReg -> Bool
(VirtualReg -> VirtualReg -> Bool)
-> (VirtualReg -> VirtualReg -> Bool) -> Eq VirtualReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VirtualReg -> VirtualReg -> Bool
$c/= :: VirtualReg -> VirtualReg -> Bool
== :: VirtualReg -> VirtualReg -> Bool
$c== :: VirtualReg -> VirtualReg -> Bool
Eq, Int -> VirtualReg -> ShowS
[VirtualReg] -> ShowS
VirtualReg -> String
(Int -> VirtualReg -> ShowS)
-> (VirtualReg -> String)
-> ([VirtualReg] -> ShowS)
-> Show VirtualReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualReg] -> ShowS
$cshowList :: [VirtualReg] -> ShowS
show :: VirtualReg -> String
$cshow :: VirtualReg -> String
showsPrec :: Int -> VirtualReg -> ShowS
$cshowsPrec :: Int -> VirtualReg -> ShowS
Show)

-- This is laborious, but necessary. 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 (VirtualRegI a :: Unique
a) (VirtualRegI b :: Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
  compare (VirtualRegHi a :: Unique
a) (VirtualRegHi b :: Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
  compare (VirtualRegF a :: Unique
a) (VirtualRegF b :: Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
  compare (VirtualRegD a :: Unique
a) (VirtualRegD b :: Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
  compare (VirtualRegSSE a :: Unique
a) (VirtualRegSSE b :: Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
  compare VirtualRegI{} _ = Ordering
LT
  compare _ VirtualRegI{} = Ordering
GT
  compare VirtualRegHi{} _ = Ordering
LT
  compare _ VirtualRegHi{} = Ordering
GT
  compare VirtualRegF{} _ = Ordering
LT
  compare _ VirtualRegF{} = Ordering
GT
  compare VirtualRegD{} _ = Ordering
LT
  compare _ VirtualRegD{} = Ordering
GT


instance Uniquable VirtualReg where
        getUnique :: VirtualReg -> Unique
getUnique reg :: VirtualReg
reg
         = case VirtualReg
reg of
                VirtualRegI u :: Unique
u   -> Unique
u
                VirtualRegHi u :: Unique
u  -> Unique
u
                VirtualRegF u :: Unique
u   -> Unique
u
                VirtualRegD u :: Unique
u   -> Unique
u
                VirtualRegSSE u :: Unique
u -> Unique
u

instance Outputable VirtualReg where
        ppr :: VirtualReg -> SDoc
ppr reg :: VirtualReg
reg
         = case VirtualReg
reg of
                VirtualRegI  u :: Unique
u  -> String -> SDoc
text "%vI_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegHi u :: Unique
u  -> String -> SDoc
text "%vHi_"  SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegF  u :: Unique
u  -> String -> SDoc
text "%vF_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegD  u :: Unique
u  -> String -> SDoc
text "%vD_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegSSE u :: Unique
u -> String -> SDoc
text "%vSSE_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u


renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg u :: Unique
u r :: VirtualReg
r
 = case VirtualReg
r of
        VirtualRegI _   -> Unique -> VirtualReg
VirtualRegI  Unique
u
        VirtualRegHi _  -> Unique -> VirtualReg
VirtualRegHi Unique
u
        VirtualRegF _   -> Unique -> VirtualReg
VirtualRegF  Unique
u
        VirtualRegD _   -> Unique -> VirtualReg
VirtualRegD  Unique
u
        VirtualRegSSE _ -> Unique -> VirtualReg
VirtualRegSSE Unique
u


classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg vr :: VirtualReg
vr
 = case VirtualReg
vr of
        VirtualRegI{}   -> RegClass
RcInteger
        VirtualRegHi{}  -> RegClass
RcInteger
        VirtualRegF{}   -> RegClass
RcFloat
        VirtualRegD{}   -> RegClass
RcDouble
        VirtualRegSSE{} -> RegClass
RcDoubleSSE


-- 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 reg :: VirtualReg
reg
 = case VirtualReg
reg of
        -- makes a pseudo-unique with tag 'H'
        VirtualRegI u :: Unique
u   -> Unique -> VirtualReg
VirtualRegHi (Unique -> Char -> Unique
newTagUnique Unique
u 'H')
        _               -> String -> VirtualReg
forall a. String -> a
panic "Reg.getHiVirtualRegFromLo"

getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo reg :: Reg
reg
 = case Reg
reg of
        RegVirtual  vr :: VirtualReg
vr  -> VirtualReg -> Reg
RegVirtual (VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
vr)
        RegReal _       -> String -> Reg
forall a. String -> a
panic "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.
--
--      RealRegPairs are pairs of real registers that are allocated together
--      to hold a larger value, such as with Double regs on SPARC.
--
data RealReg
        = RealRegSingle {-# UNPACK #-} !RegNo
        | RealRegPair   {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
        deriving (RealReg -> RealReg -> Bool
(RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool) -> Eq RealReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealReg -> RealReg -> Bool
$c/= :: RealReg -> RealReg -> Bool
== :: RealReg -> RealReg -> Bool
$c== :: RealReg -> RealReg -> Bool
Eq, Int -> RealReg -> ShowS
[RealReg] -> ShowS
RealReg -> String
(Int -> RealReg -> ShowS)
-> (RealReg -> String) -> ([RealReg] -> ShowS) -> Show RealReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealReg] -> ShowS
$cshowList :: [RealReg] -> ShowS
show :: RealReg -> String
$cshow :: RealReg -> String
showsPrec :: Int -> RealReg -> ShowS
$cshowsPrec :: Int -> 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
min :: RealReg -> RealReg -> RealReg
$cmin :: RealReg -> RealReg -> RealReg
max :: RealReg -> RealReg -> RealReg
$cmax :: RealReg -> RealReg -> RealReg
>= :: RealReg -> RealReg -> Bool
$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
compare :: RealReg -> RealReg -> Ordering
$ccompare :: RealReg -> RealReg -> Ordering
$cp1Ord :: Eq RealReg
Ord)

instance Uniquable RealReg where
        getUnique :: RealReg -> Unique
getUnique reg :: RealReg
reg
         = case RealReg
reg of
                RealRegSingle i :: Int
i         -> Int -> Unique
mkRegSingleUnique Int
i
                RealRegPair r1 :: Int
r1 r2 :: Int
r2       -> Int -> Unique
mkRegPairUnique (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 65536 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2)

instance Outputable RealReg where
        ppr :: RealReg -> SDoc
ppr reg :: RealReg
reg
         = case RealReg
reg of
                RealRegSingle i :: Int
i         -> String -> SDoc
text "%r"  SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
                RealRegPair r1 :: Int
r1 r2 :: Int
r2       -> String -> SDoc
text "%r(" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
r1
                                           SDoc -> SDoc -> SDoc
<> SDoc
vbar SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
r2 SDoc -> SDoc -> SDoc
<> String -> SDoc
text ")"

regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg :: RealReg -> [Int]
regNosOfRealReg rr :: RealReg
rr
 = case RealReg
rr of
        RealRegSingle r1 :: Int
r1        -> [Int
r1]
        RealRegPair   r1 :: Int
r1 r2 :: Int
r2     -> [Int
r1, Int
r2]


realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias rr1 :: RealReg
rr1 rr2 :: RealReg
rr2
        = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
intersect (RealReg -> [Int]
regNosOfRealReg RealReg
rr1) (RealReg -> [Int]
regNosOfRealReg RealReg
rr2)

--------------------------------------------------------------------------------
-- | 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
/= :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c== :: 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
min :: Reg -> Reg -> Reg
$cmin :: Reg -> Reg -> Reg
max :: Reg -> Reg -> Reg
$cmax :: Reg -> Reg -> Reg
>= :: Reg -> Reg -> Bool
$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
compare :: Reg -> Reg -> Ordering
$ccompare :: Reg -> Reg -> Ordering
$cp1Ord :: Eq Reg
Ord)

regSingle :: RegNo -> Reg
regSingle :: Int -> Reg
regSingle regNo :: Int
regNo         = RealReg -> Reg
RegReal (RealReg -> Reg) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ Int -> RealReg
RealRegSingle Int
regNo

regPair :: RegNo -> RegNo -> Reg
regPair :: Int -> Int -> Reg
regPair regNo1 :: Int
regNo1 regNo2 :: Int
regNo2   = RealReg -> Reg
RegReal (RealReg -> Reg) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RealReg
RealRegPair Int
regNo1 Int
regNo2


-- 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
reg
         = case Reg
reg of
                RegVirtual vr :: VirtualReg
vr   -> VirtualReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique VirtualReg
vr
                RegReal    rr :: 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
reg
         = case Reg
reg of
                RegVirtual vr :: VirtualReg
vr   -> VirtualReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr VirtualReg
vr
                RegReal    rr :: RealReg
rr   -> RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
rr


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

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


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

takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg reg :: Reg
reg
 = case Reg
reg of
        RegReal _       -> Maybe VirtualReg
forall a. Maybe a
Nothing
        RegVirtual vr :: 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 patchF :: VirtualReg -> RealReg
patchF reg :: Reg
reg
 = case Reg
reg of
        RegVirtual vr :: VirtualReg
vr   -> RealReg -> Reg
RegReal (VirtualReg -> RealReg
patchF VirtualReg
vr)
        RegReal _       -> Reg
reg