content: {-# 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    { 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 (Eq, 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 vr1 vr2 =
      case compare (I# (dataToTag# vr1)) (I# (dataToTag# vr2)) of
        LT -> LT
        GT -> GT
        EQ -> nonDetCmpUnique (virtualRegUnique vr1) (virtualRegUnique vr2)
  
  instance Uniquable VirtualReg where
          getUnique = virtualRegUnique
  
  instance Outputable VirtualReg where
          ppr reg
           = case reg of
                  VirtualRegI    u -> text "%vI_"   <> pprUniqueAlways u
                  VirtualRegHi   u -> text "%vHi_"  <> pprUniqueAlways u
                  VirtualRegD    u -> text "%vDouble_" <> pprUniqueAlways u
                  VirtualRegV128 u -> text "%vV128_"   <> pprUniqueAlways u
  
  
  renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
  renameVirtualReg u r = r { virtualRegUnique = u }
  
  classOfVirtualReg :: Arch -> VirtualReg -> RegClass
  classOfVirtualReg arch vr
    = case vr of
          VirtualRegI{} ->
            case regArch of
              Unified   ->   Unified.RcInteger
              Separate  ->  Separate.RcInteger
              NoVectors -> NoVectors.RcInteger
          VirtualRegHi{} ->
            case regArch of
              Unified   ->   Unified.RcInteger
              Separate  ->  Separate.RcInteger
              NoVectors -> NoVectors.RcInteger
          VirtualRegD{} ->
            case regArch of
              Unified   ->   Unified.RcFloatOrVector
              Separate  ->  Separate.RcFloat
              NoVectors -> NoVectors.RcFloat
          VirtualRegV128{} ->
            case regArch of
              Unified   ->  Unified.RcFloatOrVector
              Separate  -> Separate.RcVector
              NoVectors -> pprPanic "classOfVirtualReg VirtualRegV128"
                             ( text "arch:" <+> text ( show arch ) )
    where
      regArch = registerArch 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 reg
   = case reg of
          -- makes a pseudo-unique with tag 'H'
          VirtualRegI u   -> VirtualRegHi (newTagUnique u 'H')
          _               -> panic "Reg.getHiVirtualRegFromLo"
  
  getHiVRegFromLo :: Reg -> Reg
  getHiVRegFromLo reg
   = case reg of
          RegVirtual  vr  -> RegVirtual (getHiVirtualRegFromLo vr)
          RegReal _       -> 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.
  --
  newtype RealReg
          = RealRegSingle RegNo
          deriving (Eq, Show, Ord)
  
  instance Uniquable RealReg where
          getUnique reg
           = case reg of
                  RealRegSingle i         -> mkRegSingleUnique i
  
  instance Outputable RealReg where
          ppr reg
           = case reg of
                  RealRegSingle i         -> text "%r"  <> int i
  
  regNosOfRealReg :: RealReg -> [RegNo]
  regNosOfRealReg rr
   = case rr of
          RealRegSingle r1        -> [r1]
  
  
  realRegsAlias :: RealReg -> RealReg -> Bool
  realRegsAlias rr1 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 rr1 of
          RealRegSingle r1 ->
              case rr2 of RealRegSingle r2 -> r1 == r2
  
  --------------------------------------------------------------------------------
  -- | A register, either virtual or real
  data Reg
          = RegVirtual !VirtualReg
          | RegReal    !RealReg
          deriving (Eq, Ord, Show)
  
  regSingle :: RegNo -> Reg
  regSingle regNo = RegReal (realRegSingle regNo)
  
  realRegSingle :: RegNo -> RealReg
  realRegSingle regNo = RealRegSingle 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
           = case reg of
                  RegVirtual vr   -> getUnique vr
                  RegReal    rr   -> getUnique 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
           = case reg of
                  RegVirtual vr   -> ppr vr
                  RegReal    rr   -> ppr rr
  
  
  isRealReg :: Reg -> Bool
  isRealReg reg
   = case reg of
          RegReal _       -> True
          RegVirtual _    -> False
  
  takeRealReg :: Reg -> Maybe RealReg
  takeRealReg reg
   = case reg of
          RegReal rr      -> Just rr
          _               -> Nothing
  
  
  isVirtualReg :: Reg -> Bool
  isVirtualReg reg
   = case reg of
          RegReal _       -> False
          RegVirtual _    -> True
  
  takeVirtualReg :: Reg -> Maybe VirtualReg
  takeVirtualReg reg
   = case reg of
          RegReal _       -> Nothing
          RegVirtual vr   -> Just 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 patchF reg
   = case reg of
          RegVirtual vr   -> RegReal (patchF vr)
          RegReal _       -> reg
  