{-# LANGUAGE CPP #-}

-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 1994-2004
--
-- -----------------------------------------------------------------------------

module GHC.CmmToAsm.PPC.Regs (
        -- squeeze functions
        virtualRegSqueeze,
        realRegSqueeze,

        mkVirtualReg,
        regDotColor,

        -- immediates
        Imm(..),
        strImmLit,
        litToImm,

        -- addressing modes
        AddrMode(..),
        addrOffset,

        -- registers
        spRel,
        argRegs,
        allArgRegs,
        callClobberedRegs,
        allMachRegNos,
        classOfRealReg,
        showReg,
        toRegNo,

        -- machine specific
        allFPArgRegs,
        fits16Bits,
        makeImmediate,
        fReg,
        r0, sp, toc, r3, r4, r11, r12, r30,
        tmpReg,
        f1,

        allocatableRegs

)

where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Format

import GHC.Cmm
import GHC.Cmm.CLabel           ( CLabel )
import GHC.Types.Unique

import GHC.Platform.Regs
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform

import Data.Word        ( Word8, Word16, Word32, Word64 )
import Data.Int         ( Int8, Int16, Int32, Int64 )


-- squeese functions for the graph allocator -----------------------------------

-- | regSqueeze_class reg
--      Calculate the maximum number of register colors that could be
--      denied to a node of this class due to having this reg
--      as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
virtualRegSqueeze :: RegClass -> VirtualReg -> Int
virtualRegSqueeze :: RegClass -> VirtualReg -> RegNo
virtualRegSqueeze RegClass
cls VirtualReg
vr
 = case RegClass
cls of
        RegClass
RcInteger
         -> case VirtualReg
vr of
                VirtualRegI{}           -> RegNo
1
                VirtualRegHi{}          -> RegNo
1
                VirtualReg
_other                  -> RegNo
0

        RegClass
RcDouble
         -> case VirtualReg
vr of
                VirtualRegD{}           -> RegNo
1
                VirtualRegF{}           -> RegNo
0
                VirtualReg
_other                  -> RegNo
0

        RegClass
_other -> RegNo
0

{-# INLINE realRegSqueeze #-}
realRegSqueeze :: RegClass -> RealReg -> Int
realRegSqueeze :: RegClass -> RealReg -> RegNo
realRegSqueeze RegClass
cls RealReg
rr
 = case RegClass
cls of
        RegClass
RcInteger
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
1     -- first fp reg is 32
                        | Bool
otherwise     -> RegNo
0

                RealRegPair{}           -> RegNo
0

        RegClass
RcDouble
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
0
                        | Bool
otherwise     -> RegNo
1

                RealRegPair{}           -> RegNo
0

        RegClass
_other -> RegNo
0

mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg Unique
u Format
format
   | Bool -> Bool
not (Format -> Bool
isFloatFormat Format
format) = Unique -> VirtualReg
VirtualRegI Unique
u
   | Bool
otherwise
   = case Format
format of
        Format
FF32    -> Unique -> VirtualReg
VirtualRegD Unique
u
        Format
FF64    -> Unique -> VirtualReg
VirtualRegD Unique
u
        Format
_       -> forall a. String -> a
panic String
"mkVirtualReg"

regDotColor :: RealReg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor RealReg
reg
 = case RealReg -> RegClass
classOfRealReg RealReg
reg of
        RegClass
RcInteger       -> String -> SDoc
text String
"blue"
        RegClass
RcFloat         -> String -> SDoc
text String
"red"
        RegClass
RcDouble        -> String -> SDoc
text String
"green"



-- immediates ------------------------------------------------------------------
data Imm
        = ImmInt        Int
        | ImmInteger    Integer     -- Sigh.
        | ImmCLbl       CLabel      -- AbstractC Label (with baggage)
        | ImmLit        SDoc        -- Simple string
        | ImmIndex    CLabel Int
        | ImmFloat      Rational
        | ImmDouble     Rational
        | ImmConstantSum Imm Imm
        | ImmConstantDiff Imm Imm
        | LO Imm
        | HI Imm
        | HA Imm        {- high halfword adjusted -}
        | HIGHERA Imm
        | HIGHESTA Imm


strImmLit :: String -> Imm
strImmLit :: String -> Imm
strImmLit String
s = SDoc -> Imm
ImmLit (String -> SDoc
text String
s)


litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm (CmmInt Integer
i Width
w)        = Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowS Width
w Integer
i)
                -- narrow to the width: a CmmInt might be out of
                -- range, but we assume that ImmInteger only contains
                -- in-range values.  A signed value should be fine here.
litToImm (CmmFloat Rational
f Width
W32)    = Rational -> Imm
ImmFloat Rational
f
litToImm (CmmFloat Rational
f Width
W64)    = Rational -> Imm
ImmDouble Rational
f
litToImm (CmmLabel CLabel
l)        = CLabel -> Imm
ImmCLbl CLabel
l
litToImm (CmmLabelOff CLabel
l RegNo
off) = CLabel -> RegNo -> Imm
ImmIndex CLabel
l RegNo
off
litToImm (CmmLabelDiffOff CLabel
l1 CLabel
l2 RegNo
off Width
_)
                             = Imm -> Imm -> Imm
ImmConstantSum
                               (Imm -> Imm -> Imm
ImmConstantDiff (CLabel -> Imm
ImmCLbl CLabel
l1) (CLabel -> Imm
ImmCLbl CLabel
l2))
                               (RegNo -> Imm
ImmInt RegNo
off)
litToImm CmmLit
_                   = forall a. String -> a
panic String
"PPC.Regs.litToImm: no match"


-- addressing modes ------------------------------------------------------------

data AddrMode
        = AddrRegReg    Reg Reg
        | AddrRegImm    Reg Imm


addrOffset :: AddrMode -> Int -> Maybe AddrMode
addrOffset :: AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr RegNo
off
  = case AddrMode
addr of
      AddrRegImm Reg
r (ImmInt RegNo
n)
       | forall a. Integral a => a -> Bool
fits16Bits RegNo
n2 -> forall a. a -> Maybe a
Just (Reg -> Imm -> AddrMode
AddrRegImm Reg
r (RegNo -> Imm
ImmInt RegNo
n2))
       | Bool
otherwise     -> forall a. Maybe a
Nothing
       where n2 :: RegNo
n2 = RegNo
n forall a. Num a => a -> a -> a
+ RegNo
off

      AddrRegImm Reg
r (ImmInteger Integer
n)
       | forall a. Integral a => a -> Bool
fits16Bits Integer
n2 -> forall a. a -> Maybe a
Just (Reg -> Imm -> AddrMode
AddrRegImm Reg
r (RegNo -> Imm
ImmInt (forall a. Num a => Integer -> a
fromInteger Integer
n2)))
       | Bool
otherwise     -> forall a. Maybe a
Nothing
       where n2 :: Integer
n2 = Integer
n forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger RegNo
off

      AddrMode
_ -> forall a. Maybe a
Nothing


-- registers -------------------------------------------------------------------
-- @spRel@ gives us a stack relative addressing mode for volatile
-- temporaries and for excess call arguments.  @fpRel@, where
-- applicable, is the same but for the frame pointer.

spRel :: Platform
      -> Int    -- desired stack offset in words, positive or negative
      -> AddrMode

spRel :: Platform -> RegNo -> AddrMode
spRel Platform
platform RegNo
n = Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (RegNo -> Imm
ImmInt (RegNo
n forall a. Num a => a -> a -> a
* Platform -> RegNo
platformWordSizeInBytes Platform
platform))


-- argRegs is the set of regs which are read for an n-argument call to C.
-- For archs which pass all args on the stack (x86), is empty.
-- Sparc passes up to the first 6 args in regs.
argRegs :: RegNo -> [Reg]
argRegs :: RegNo -> [Reg]
argRegs RegNo
0 = []
argRegs RegNo
1 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3]
argRegs RegNo
2 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3,RegNo
4]
argRegs RegNo
3 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
5]
argRegs RegNo
4 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
6]
argRegs RegNo
5 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
7]
argRegs RegNo
6 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
8]
argRegs RegNo
7 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
9]
argRegs RegNo
8 = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
10]
argRegs RegNo
_ = forall a. String -> a
panic String
"MachRegs.argRegs(powerpc): don't know about >8 arguments!"


allArgRegs :: [Reg]
allArgRegs :: [Reg]
allArgRegs = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
10]


-- these are the regs which we cannot assume stay alive over a C call.
callClobberedRegs :: Platform -> [Reg]
callClobberedRegs :: Platform -> [Reg]
callClobberedRegs Platform
_platform
  = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle (RegNo
0forall a. a -> [a] -> [a]
:[RegNo
2..RegNo
12] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RegNo
fReg [RegNo
0..RegNo
13])


allMachRegNos   :: [RegNo]
allMachRegNos :: [RegNo]
allMachRegNos   = [RegNo
0..RegNo
63]


{-# INLINE classOfRealReg      #-}
classOfRealReg :: RealReg -> RegClass
classOfRealReg :: RealReg -> RegClass
classOfRealReg (RealRegSingle RegNo
i)
        | RegNo
i forall a. Ord a => a -> a -> Bool
< RegNo
32        = RegClass
RcInteger
        | Bool
otherwise     = RegClass
RcDouble

classOfRealReg (RealRegPair{})
        = forall a. String -> a
panic String
"regClass(ppr): no reg pairs on this architecture"

showReg :: RegNo -> String
showReg :: RegNo -> String
showReg RegNo
n
    | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
0 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
<= RegNo
31   = String
"%r" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RegNo
n
    | RegNo
n forall a. Ord a => a -> a -> Bool
>= RegNo
32 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
<= RegNo
63  = String
"%f" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RegNo
n forall a. Num a => a -> a -> a
- RegNo
32)
    | Bool
otherwise           = String
"%unknown_powerpc_real_reg_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RegNo
n

toRegNo :: Reg -> RegNo
toRegNo :: Reg -> RegNo
toRegNo (RegReal (RealRegSingle RegNo
n)) = RegNo
n
toRegNo Reg
_                           = forall a. String -> a
panic String
"PPC.toRegNo: unsupported register"

-- machine specific ------------------------------------------------------------

allFPArgRegs :: Platform -> [Reg]
allFPArgRegs :: Platform -> [Reg]
allFPArgRegs Platform
platform
    = case Platform -> OS
platformOS Platform
platform of
      OS
OSAIX    -> forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
fReg) [RegNo
1..RegNo
13]
      OS
_        -> case Platform -> Arch
platformArch Platform
platform of
        Arch
ArchPPC      -> forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
fReg) [RegNo
1..RegNo
8]
        ArchPPC_64 PPC_64ABI
_ -> forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
fReg) [RegNo
1..RegNo
13]
        Arch
_            -> forall a. String -> a
panic String
"PPC.Regs.allFPArgRegs: unknown PPC Linux"

fits16Bits :: Integral a => a -> Bool
fits16Bits :: forall a. Integral a => a -> Bool
fits16Bits a
x = a
x forall a. Ord a => a -> a -> Bool
>= -a
32768 Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
32768

makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate :: forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
signed a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RegNo -> Imm
ImmInt (Width -> Bool -> Maybe RegNo
toI16 Width
rep Bool
signed)
    where
        narrow :: Width -> Bool -> RegNo
narrow Width
W64 Bool
False = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word64)
        narrow Width
W32 Bool
False = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word32)
        narrow Width
W16 Bool
False = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word16)
        narrow Width
W8  Bool
False = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word8)
        narrow Width
W64 Bool
True  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Int64)
        narrow Width
W32 Bool
True  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Int32)
        narrow Width
W16 Bool
True  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Int16)
        narrow Width
W8  Bool
True  = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Int8)
        narrow Width
_   Bool
_     = forall a. String -> a
panic String
"PPC.Regs.narrow: no match"

        narrowed :: RegNo
narrowed = Width -> Bool -> RegNo
narrow Width
rep Bool
signed

        toI16 :: Width -> Bool -> Maybe RegNo
toI16 Width
W32 Bool
True
            | RegNo
narrowed forall a. Ord a => a -> a -> Bool
>= -RegNo
32768 Bool -> Bool -> Bool
&& RegNo
narrowed forall a. Ord a => a -> a -> Bool
< RegNo
32768 = forall a. a -> Maybe a
Just RegNo
narrowed
            | Bool
otherwise = forall a. Maybe a
Nothing
        toI16 Width
W32 Bool
False
            | RegNo
narrowed forall a. Ord a => a -> a -> Bool
>= RegNo
0 Bool -> Bool -> Bool
&& RegNo
narrowed forall a. Ord a => a -> a -> Bool
< RegNo
65536 = forall a. a -> Maybe a
Just RegNo
narrowed
            | Bool
otherwise = forall a. Maybe a
Nothing
        toI16 Width
W64 Bool
True
            | RegNo
narrowed forall a. Ord a => a -> a -> Bool
>= -RegNo
32768 Bool -> Bool -> Bool
&& RegNo
narrowed forall a. Ord a => a -> a -> Bool
< RegNo
32768 = forall a. a -> Maybe a
Just RegNo
narrowed
            | Bool
otherwise = forall a. Maybe a
Nothing
        toI16 Width
W64 Bool
False
            | RegNo
narrowed forall a. Ord a => a -> a -> Bool
>= RegNo
0 Bool -> Bool -> Bool
&& RegNo
narrowed forall a. Ord a => a -> a -> Bool
< RegNo
65536 = forall a. a -> Maybe a
Just RegNo
narrowed
            | Bool
otherwise = forall a. Maybe a
Nothing
        toI16 Width
_ Bool
_  = forall a. a -> Maybe a
Just RegNo
narrowed


{-
The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
point registers.
-}

fReg :: Int -> RegNo
fReg :: RegNo -> RegNo
fReg RegNo
x = (RegNo
32 forall a. Num a => a -> a -> a
+ RegNo
x)

r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
r0 :: Reg
r0      = RegNo -> Reg
regSingle RegNo
0
sp :: Reg
sp      = RegNo -> Reg
regSingle RegNo
1
toc :: Reg
toc     = RegNo -> Reg
regSingle RegNo
2
r3 :: Reg
r3      = RegNo -> Reg
regSingle RegNo
3
r4 :: Reg
r4      = RegNo -> Reg
regSingle RegNo
4
r11 :: Reg
r11     = RegNo -> Reg
regSingle RegNo
11
r12 :: Reg
r12     = RegNo -> Reg
regSingle RegNo
12
r30 :: Reg
r30     = RegNo -> Reg
regSingle RegNo
30
f1 :: Reg
f1      = RegNo -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ RegNo -> RegNo
fReg RegNo
1

-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
-- register allocator to attempt to map VRegs to.
allocatableRegs :: Platform -> [RealReg]
allocatableRegs :: Platform -> [RealReg]
allocatableRegs Platform
platform
   = let isFree :: RegNo -> Bool
isFree RegNo
i = Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
i
     in  forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter RegNo -> Bool
isFree [RegNo]
allMachRegNos

-- temporary register for compiler use
tmpReg :: Platform -> Reg
tmpReg :: Platform -> Reg
tmpReg Platform
platform =
       case Platform -> Arch
platformArch Platform
platform of
       Arch
ArchPPC      -> RegNo -> Reg
regSingle RegNo
13
       ArchPPC_64 PPC_64ABI
_ -> RegNo -> Reg
regSingle RegNo
30
       Arch
_            -> forall a. String -> a
panic String
"PPC.Regs.tmpReg: unknown arch"