{-# LANGUAGE CPP #-}

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

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

        mkVirtualReg,
        regDotColor,

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

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

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

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

        allocatableRegs

)

where

#include "nativeGen/NCG.h"
#include "HsVersions.h"

import GhcPrelude

import Reg
import RegClass
import Format

import Cmm
import CLabel           ( CLabel )
import Unique

import CodeGen.Platform
import DynFlags
import Outputable
import 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 -> Int
virtualRegSqueeze cls :: RegClass
cls vr :: VirtualReg
vr
 = case RegClass
cls of
        RcInteger
         -> case VirtualReg
vr of
                VirtualRegI{}           -> 1
                VirtualRegHi{}          -> 1
                _other :: VirtualReg
_other                  -> 0

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

        _other :: RegClass
_other -> 0

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

                RealRegPair{}           -> 0

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

                RealRegPair{}           -> 0

        _other :: RegClass
_other -> 0

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

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


-- 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 s :: String
s = SDoc -> Imm
ImmLit (String -> SDoc
text String
s)


litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm (CmmInt i :: Integer
i w :: 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 f :: Rational
f W32)    = Rational -> Imm
ImmFloat Rational
f
litToImm (CmmFloat f :: Rational
f W64)    = Rational -> Imm
ImmDouble Rational
f
litToImm (CmmLabel l :: CLabel
l)        = CLabel -> Imm
ImmCLbl CLabel
l
litToImm (CmmLabelOff l :: CLabel
l off :: Int
off) = CLabel -> Int -> Imm
ImmIndex CLabel
l Int
off
litToImm (CmmLabelDiffOff l1 :: CLabel
l1 l2 :: CLabel
l2 off :: Int
off _)
                             = Imm -> Imm -> Imm
ImmConstantSum
                               (Imm -> Imm -> Imm
ImmConstantDiff (CLabel -> Imm
ImmCLbl CLabel
l1) (CLabel -> Imm
ImmCLbl CLabel
l2))
                               (Int -> Imm
ImmInt Int
off)
litToImm _                   = String -> Imm
forall a. String -> a
panic "PPC.Regs.litToImm: no match"


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

data AddrMode
        = AddrRegReg    Reg Reg
        | AddrRegImm    Reg Imm


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

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

      _ -> Maybe 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 :: DynFlags
      -> Int    -- desired stack offset in words, positive or negative
      -> AddrMode

spRel :: DynFlags -> Int -> AddrMode
spRel dflags :: DynFlags
dflags n :: Int
n = Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* DynFlags -> Int
wORD_SIZE DynFlags
dflags))


-- 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 :: Int -> [Reg]
argRegs 0 = []
argRegs 1 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3]
argRegs 2 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3,4]
argRegs 3 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..5]
argRegs 4 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..6]
argRegs 5 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..7]
argRegs 6 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..8]
argRegs 7 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..9]
argRegs 8 = (Int -> Reg) -> [Int] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Reg
regSingle [3..10]
argRegs _ = String -> [Reg]
forall a. String -> a
panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"


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


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


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


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

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

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



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

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

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

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

        narrowed :: Int
narrowed = Width -> Bool -> Int
forall p. Num p => Width -> Bool -> p
narrow Width
rep Bool
signed

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


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

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

r0, sp, toc, r3, r4, r11, r12, r27, r28, r30, f1, f20, f21 :: Reg
r0 :: Reg
r0      = Int -> Reg
regSingle 0
sp :: Reg
sp      = Int -> Reg
regSingle 1
toc :: Reg
toc     = Int -> Reg
regSingle 2
r3 :: Reg
r3      = Int -> Reg
regSingle 3
r4 :: Reg
r4      = Int -> Reg
regSingle 4
r11 :: Reg
r11     = Int -> Reg
regSingle 11
r12 :: Reg
r12     = Int -> Reg
regSingle 12
r27 :: Reg
r27     = Int -> Reg
regSingle 27
r28 :: Reg
r28     = Int -> Reg
regSingle 28
r30 :: Reg
r30     = Int -> Reg
regSingle 30
f1 :: Reg
f1      = Int -> Reg
regSingle (Int -> Reg) -> Int -> Reg
forall a b. (a -> b) -> a -> b
$ Int -> Int
fReg 1
f20 :: Reg
f20     = Int -> Reg
regSingle (Int -> Reg) -> Int -> Reg
forall a b. (a -> b) -> a -> b
$ Int -> Int
fReg 20
f21 :: Reg
f21     = Int -> Reg
regSingle (Int -> Reg) -> Int -> Reg
forall a b. (a -> b) -> a -> b
$ Int -> Int
fReg 21

-- 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
platform
   = let isFree :: Int -> Bool
isFree i :: Int
i = Platform -> Int -> Bool
freeReg Platform
platform Int
i
     in  (Int -> RealReg) -> [Int] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> RealReg
RealRegSingle ([Int] -> [RealReg]) -> [Int] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
isFree [Int]
allMachRegNos

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