never executed always true always false
    1 {-# OPTIONS_GHC -fno-warn-orphans #-}
    2 module GHC.CmmToAsm.AArch64.Regs where
    3 
    4 import GHC.Prelude
    5 
    6 import GHC.Platform.Reg
    7 import GHC.Platform.Reg.Class
    8 import GHC.CmmToAsm.Format
    9 
   10 import GHC.Cmm
   11 import GHC.Cmm.CLabel           ( CLabel )
   12 import GHC.Types.Unique
   13 
   14 import GHC.Platform.Regs
   15 import GHC.Utils.Outputable
   16 import GHC.Utils.Panic
   17 import GHC.Platform
   18 
   19 allMachRegNos   :: [RegNo]
   20 allMachRegNos   = [0..31] ++ [32..63]
   21 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
   22 -- i.e., these are the regs for which we are prepared to allow the
   23 -- register allocator to attempt to map VRegs to.
   24 allocatableRegs :: Platform -> [RealReg]
   25 allocatableRegs platform
   26    = let isFree i = freeReg platform i
   27      in  map RealRegSingle $ filter isFree allMachRegNos
   28 
   29 
   30 -- argRegs is the set of regs which are read for an n-argument call to C.
   31 allGpArgRegs :: [Reg]
   32 allGpArgRegs = map regSingle [0..7]
   33 allFpArgRegs :: [Reg]
   34 allFpArgRegs = map regSingle [32..39]
   35 
   36 -- STG:
   37 -- 19: Base
   38 -- 20: Sp
   39 -- 21: Hp
   40 -- 22-27: R1-R6
   41 -- 28: SpLim
   42 
   43 -- This is the STG Sp reg.
   44 -- sp :: Reg
   45 -- sp = regSingle 20
   46 
   47 -- addressing modes ------------------------------------------------------------
   48 
   49 data AddrMode
   50         = AddrRegReg    Reg Reg
   51         | AddrRegImm    Reg Imm
   52         | AddrReg       Reg
   53         deriving (Eq, Show)
   54 
   55 -- -----------------------------------------------------------------------------
   56 -- Immediates
   57 
   58 data Imm
   59   = ImmInt      Int
   60   | ImmInteger  Integer     -- Sigh.
   61   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
   62   | ImmLit      SDoc        -- Simple string
   63   | ImmIndex    CLabel Int
   64   | ImmFloat    Rational
   65   | ImmDouble   Rational
   66   | ImmConstantSum Imm Imm
   67   | ImmConstantDiff Imm Imm
   68   deriving (Eq, Show)
   69 
   70 instance Show SDoc where
   71   show = showPprUnsafe . ppr
   72 
   73 instance Eq SDoc where
   74   lhs == rhs = show lhs == show rhs
   75 
   76 strImmLit :: String -> Imm
   77 strImmLit s = ImmLit (text s)
   78 
   79 
   80 litToImm :: CmmLit -> Imm
   81 litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
   82                 -- narrow to the width: a CmmInt might be out of
   83                 -- range, but we assume that ImmInteger only contains
   84                 -- in-range values.  A signed value should be fine here.
   85 litToImm (CmmFloat f W32)    = ImmFloat f
   86 litToImm (CmmFloat f W64)    = ImmDouble f
   87 litToImm (CmmLabel l)        = ImmCLbl l
   88 litToImm (CmmLabelOff l off) = ImmIndex l off
   89 litToImm (CmmLabelDiffOff l1 l2 off _)
   90                              = ImmConstantSum
   91                                (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
   92                                (ImmInt off)
   93 litToImm _                   = panic "AArch64.Regs.litToImm: no match"
   94 
   95 
   96 -- == To satisfy GHC.CmmToAsm.Reg.Target =======================================
   97 
   98 -- squeese functions for the graph allocator -----------------------------------
   99 -- | regSqueeze_class reg
  100 --      Calculate the maximum number of register colors that could be
  101 --      denied to a node of this class due to having this reg
  102 --      as a neighbour.
  103 --
  104 {-# INLINE virtualRegSqueeze #-}
  105 virtualRegSqueeze :: RegClass -> VirtualReg -> Int
  106 virtualRegSqueeze cls vr
  107  = case cls of
  108         RcInteger
  109          -> case vr of
  110                 VirtualRegI{}           -> 1
  111                 VirtualRegHi{}          -> 1
  112                 _other                  -> 0
  113 
  114         RcDouble
  115          -> case vr of
  116                 VirtualRegD{}           -> 1
  117                 VirtualRegF{}           -> 0
  118                 _other                  -> 0
  119 
  120         _other -> 0
  121 
  122 {-# INLINE realRegSqueeze #-}
  123 realRegSqueeze :: RegClass -> RealReg -> Int
  124 realRegSqueeze cls rr
  125  = case cls of
  126         RcInteger
  127          -> case rr of
  128                 RealRegSingle regNo
  129                         | regNo < 32    -> 1     -- first fp reg is 32
  130                         | otherwise     -> 0
  131 
  132                 RealRegPair{}           -> 0
  133 
  134         RcDouble
  135          -> case rr of
  136                 RealRegSingle regNo
  137                         | regNo < 32    -> 0
  138                         | otherwise     -> 1
  139 
  140                 RealRegPair{}           -> 0
  141 
  142         _other -> 0
  143 
  144 mkVirtualReg :: Unique -> Format -> VirtualReg
  145 mkVirtualReg u format
  146    | not (isFloatFormat format) = VirtualRegI u
  147    | otherwise
  148    = case format of
  149         FF32    -> VirtualRegD u
  150         FF64    -> VirtualRegD u
  151         _       -> panic "AArch64.mkVirtualReg"
  152 
  153 {-# INLINE classOfRealReg      #-}
  154 classOfRealReg :: RealReg -> RegClass
  155 classOfRealReg (RealRegSingle i)
  156         | i < 32        = RcInteger
  157         | otherwise     = RcDouble
  158 
  159 classOfRealReg (RealRegPair{})
  160         = panic "regClass(ppr): no reg pairs on this architecture"
  161 
  162 regDotColor :: RealReg -> SDoc
  163 regDotColor reg
  164  = case classOfRealReg reg of
  165         RcInteger       -> text "blue"
  166         RcFloat         -> text "red"
  167         RcDouble        -> text "green"