module GHC.CmmToAsm.PPC.Regs (
virtualRegSqueeze,
realRegSqueeze,
mkVirtualReg,
regDotColor,
Imm(..),
strImmLit,
litToImm,
AddrMode(..),
addrOffset,
spRel,
argRegs,
allArgRegs,
callClobberedRegs,
allMachRegNos,
classOfRealReg,
toRegNo,
allFPArgRegs,
fits16Bits,
makeImmediate,
fReg,
r0, sp, toc, r3, r4, r11, r12, r30,
tmpReg,
f1,
allocatableRegs
)
where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Platform.Reg
import GHC.Platform.Reg.Class.Unified
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 )
{-# 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
RcFloatOrVector
-> case VirtualReg
vr of
VirtualRegD{} -> RegNo
1
VirtualRegV128{} -> RegNo
1
VirtualReg
_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 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
32 -> RegNo
1
| Bool
otherwise -> RegNo
0
RegClass
RcFloatOrVector
-> case RealReg
rr of
RealRegSingle RegNo
regNo
| RegNo
regNo RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
32 -> RegNo
0
| Bool
otherwise -> RegNo
1
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
_ -> String -> VirtualReg
forall a. HasCallStack => 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
forall doc. IsLine doc => String -> doc
text String
"blue"
RegClass
RcFloatOrVector -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"red"
data Imm
= ImmInt Int
| ImmInteger Integer
| ImmCLbl CLabel
| ImmLit FastString
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
| ImmConstantSum Imm Imm
| ImmConstantDiff Imm Imm
| LO Imm
| HI Imm
| HA Imm
| HIGHERA Imm
| HIGHESTA Imm
strImmLit :: FastString -> Imm
strImmLit :: FastString -> Imm
strImmLit FastString
s = FastString -> Imm
ImmLit FastString
s
litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm (CmmInt Integer
i Width
w) = Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowS Width
w Integer
i)
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
_ = String -> Imm
forall a. HasCallStack => String -> a
panic String
"PPC.Regs.litToImm: no match"
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)
| RegNo -> Bool
forall a. Integral a => a -> Bool
fits16Bits RegNo
n2 -> AddrMode -> Maybe AddrMode
forall a. a -> Maybe a
Just (Reg -> Imm -> AddrMode
AddrRegImm Reg
r (RegNo -> Imm
ImmInt RegNo
n2))
| Bool
otherwise -> Maybe AddrMode
forall a. Maybe a
Nothing
where n2 :: RegNo
n2 = RegNo
n RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
off
AddrRegImm Reg
r (ImmInteger 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 (RegNo -> Imm
ImmInt (Integer -> RegNo
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
+ RegNo -> Integer
forall a. Integral a => a -> Integer
toInteger RegNo
off
AddrMode
_ -> Maybe AddrMode
forall a. Maybe a
Nothing
spRel :: Platform
-> Int
-> AddrMode
spRel :: Platform -> RegNo -> AddrMode
spRel Platform
platform RegNo
n = Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (RegNo -> Imm
ImmInt (RegNo
n RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* Platform -> RegNo
platformWordSizeInBytes Platform
platform))
argRegs :: RegNo -> [Reg]
argRegs :: RegNo -> [Reg]
argRegs RegNo
0 = []
argRegs RegNo
1 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3]
argRegs RegNo
2 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3,RegNo
4]
argRegs RegNo
3 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
5]
argRegs RegNo
4 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
6]
argRegs RegNo
5 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
7]
argRegs RegNo
6 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
8]
argRegs RegNo
7 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
9]
argRegs RegNo
8 = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
10]
argRegs RegNo
_ = String -> [Reg]
forall a. HasCallStack => String -> a
panic String
"MachRegs.argRegs(powerpc): don't know about >8 arguments!"
allArgRegs :: [Reg]
allArgRegs :: [Reg]
allArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
3..RegNo
10]
callClobberedRegs :: Platform -> [Reg]
callClobberedRegs :: Platform -> [Reg]
callClobberedRegs Platform
_platform
= (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle (RegNo
0RegNo -> [RegNo] -> [RegNo]
forall a. a -> [a] -> [a]
:[RegNo
2..RegNo
12] [RegNo] -> [RegNo] -> [RegNo]
forall a. [a] -> [a] -> [a]
++ (RegNo -> RegNo) -> [RegNo] -> [RegNo]
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 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
32 = RegClass
RcInteger
| Bool
otherwise = RegClass
RcFloatOrVector
toRegNo :: Reg -> RegNo
toRegNo :: Reg -> RegNo
toRegNo (RegReal (RealRegSingle RegNo
n)) = RegNo
n
toRegNo Reg
_ = String -> RegNo
forall a. HasCallStack => String -> a
panic String
"PPC.toRegNo: unsupported register"
allFPArgRegs :: Platform -> [Reg]
allFPArgRegs :: Platform -> [Reg]
allFPArgRegs Platform
platform
= case Platform -> OS
platformOS Platform
platform of
OS
OSAIX -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
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 -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
fReg) [RegNo
1..RegNo
8]
ArchPPC_64 PPC_64ABI
_ -> (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map (RegNo -> Reg
regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
fReg) [RegNo
1..RegNo
13]
Arch
_ -> String -> [Reg]
forall a. HasCallStack => 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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -a
32768 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
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 = (RegNo -> Imm) -> Maybe RegNo -> Maybe Imm
forall a b. (a -> b) -> Maybe a -> Maybe b
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 = Word64 -> RegNo
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 Width
W32 Bool
False = Word32 -> RegNo
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 Width
W16 Bool
False = Word16 -> RegNo
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 Width
W8 Bool
False = Word8 -> RegNo
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 Width
W64 Bool
True = Int64 -> RegNo
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 Width
W32 Bool
True = Int32 -> RegNo
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 Width
W16 Bool
True = Int16 -> RegNo
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 Width
W8 Bool
True = Int8 -> RegNo
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 Width
_ Bool
_ = String -> RegNo
forall a. HasCallStack => 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 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= -RegNo
32768 Bool -> Bool -> Bool
&& RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
32768 = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
narrowed
| Bool
otherwise = Maybe RegNo
forall a. Maybe a
Nothing
toI16 Width
W32 Bool
False
| RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
0 Bool -> Bool -> Bool
&& RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
65536 = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
narrowed
| Bool
otherwise = Maybe RegNo
forall a. Maybe a
Nothing
toI16 Width
W64 Bool
True
| RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= -RegNo
32768 Bool -> Bool -> Bool
&& RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
32768 = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
narrowed
| Bool
otherwise = Maybe RegNo
forall a. Maybe a
Nothing
toI16 Width
W64 Bool
False
| RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
0 Bool -> Bool -> Bool
&& RegNo
narrowed RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
65536 = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
narrowed
| Bool
otherwise = Maybe RegNo
forall a. Maybe a
Nothing
toI16 Width
_ Bool
_ = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
narrowed
fReg :: Int -> RegNo
fReg :: RegNo -> RegNo
fReg RegNo
x = (RegNo
32 RegNo -> RegNo -> RegNo
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 (RegNo -> Reg) -> RegNo -> Reg
forall a b. (a -> b) -> a -> b
$ RegNo -> RegNo
fReg RegNo
1
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 (RegNo -> RealReg) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle ([RegNo] -> [RealReg]) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ (RegNo -> Bool) -> [RegNo] -> [RegNo]
forall a. (a -> Bool) -> [a] -> [a]
filter RegNo -> Bool
isFree [RegNo]
allMachRegNos
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
_ -> String -> Reg
forall a. HasCallStack => String -> a
panic String
"PPC.Regs.tmpReg: unknown arch"