-- | Free regs map for PowerPC
module GHC.CmmToAsm.Reg.Linear.PPC where

import GHC.Prelude

import GHC.CmmToAsm.PPC.Regs
import GHC.Platform.Reg.Class.Unified
import GHC.Platform.Reg

import GHC.Utils.Outputable
import GHC.Platform

import Data.Word

-- The PowerPC has 32 integer and 32 floating point registers.
-- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
-- better.
-- Note that when getFreeRegs scans for free registers, it starts at register
-- 31 and counts down. This is a hack for the PowerPC - the higher-numbered
-- registers are callee-saves, while the lower regs are caller-saves, so it
-- makes sense to start at the high end.
-- Apart from that, the code does nothing PowerPC-specific, so feel free to
-- add your favourite platform to the #if (if you have 64 registers but only
-- 32-bit words).

data FreeRegs = FreeRegs !Word32 !Word32
              deriving( RegNo -> FreeRegs -> ShowS
[FreeRegs] -> ShowS
FreeRegs -> String
(RegNo -> FreeRegs -> ShowS)
-> (FreeRegs -> String) -> ([FreeRegs] -> ShowS) -> Show FreeRegs
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> FreeRegs -> ShowS
showsPrec :: RegNo -> FreeRegs -> ShowS
$cshow :: FreeRegs -> String
show :: FreeRegs -> String
$cshowList :: [FreeRegs] -> ShowS
showList :: [FreeRegs] -> ShowS
Show )  -- The Show is used in an ASSERT

instance Outputable FreeRegs where
    ppr :: FreeRegs -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (FreeRegs -> String) -> FreeRegs -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeRegs -> String
forall a. Show a => a -> String
show

noFreeRegs :: FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = Word32 -> Word32 -> FreeRegs
FreeRegs Word32
0 Word32
0

releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle RegNo
r) (FreeRegs Word32
g Word32
f)
    | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
31    = Word32 -> Word32 -> FreeRegs
FreeRegs Word32
g (Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
1 Word32 -> RegNo -> Word32
forall a. Bits a => a -> RegNo -> a
`shiftL` (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)))
    | Bool
otherwise = Word32 -> Word32 -> FreeRegs
FreeRegs (Word32
g Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
1 Word32 -> RegNo -> Word32
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
r)) Word32
f

initFreeRegs :: Platform -> FreeRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs Platform
platform = (FreeRegs -> RealReg -> FreeRegs)
-> FreeRegs -> [RealReg] -> FreeRegs
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((RealReg -> FreeRegs -> FreeRegs)
-> FreeRegs -> RealReg -> FreeRegs
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealReg -> FreeRegs -> FreeRegs
releaseReg) FreeRegs
noFreeRegs (Platform -> [RealReg]
allocatableRegs Platform
platform)

getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
cls (FreeRegs Word32
g Word32
f) =
    case RegClass
cls of
      RegClass
RcFloatOrVector -> Word32 -> Word32 -> RegNo -> [RealReg]
forall {t}. (Num t, Bits t) => t -> t -> RegNo -> [RealReg]
go Word32
f (Word32
0x80000000) RegNo
63
      RegClass
RcInteger       -> Word32 -> Word32 -> RegNo -> [RealReg]
forall {t}. (Num t, Bits t) => t -> t -> RegNo -> [RealReg]
go Word32
g (Word32
0x80000000) RegNo
31
    where
        go :: t -> t -> RegNo -> [RealReg]
go t
_ t
0 RegNo
_ = []
        go t
x t
m RegNo
i | t
x t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
m t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
0 = RegNo -> RealReg
RealRegSingle RegNo
i RealReg -> [RealReg] -> [RealReg]
forall a. a -> [a] -> [a]
: (t -> t -> RegNo -> [RealReg]
go t
x (t
m t -> RegNo -> t
forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) (RegNo -> [RealReg]) -> RegNo -> [RealReg]
forall a b. (a -> b) -> a -> b
$! RegNo
iRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-RegNo
1)
                 | Bool
otherwise    = t -> t -> RegNo -> [RealReg]
go t
x (t
m t -> RegNo -> t
forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) (RegNo -> [RealReg]) -> RegNo -> [RealReg]
forall a b. (a -> b) -> a -> b
$! RegNo
iRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
-RegNo
1

allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle RegNo
r) (FreeRegs Word32
g Word32
f)
    | RegNo
r RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
31    = Word32 -> Word32 -> FreeRegs
FreeRegs Word32
g (Word32
f Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement (Word32
1 Word32 -> RegNo -> Word32
forall a. Bits a => a -> RegNo -> a
`shiftL` (RegNo
r RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
32)))
    | Bool
otherwise = Word32 -> Word32 -> FreeRegs
FreeRegs (Word32
g Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement (Word32
1 Word32 -> RegNo -> Word32
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
r)) Word32
f