-- | Free regs map for PowerPC
module RegAlloc.Linear.PPC.FreeRegs
where

import GhcPrelude

import PPC.Regs
import RegClass
import Reg

import Outputable
import Platform

import Data.Word
import Data.Bits

-- 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( Int -> FreeRegs -> ShowS
[FreeRegs] -> ShowS
FreeRegs -> String
(Int -> FreeRegs -> ShowS)
-> (FreeRegs -> String) -> ([FreeRegs] -> ShowS) -> Show FreeRegs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeRegs] -> ShowS
$cshowList :: [FreeRegs] -> ShowS
show :: FreeRegs -> String
$cshow :: FreeRegs -> String
showsPrec :: Int -> FreeRegs -> ShowS
$cshowsPrec :: Int -> FreeRegs -> ShowS
Show )  -- The Show is used in an ASSERT

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

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

releaseReg _ _
        = String -> FreeRegs
forall a. String -> a
panic "RegAlloc.Linear.PPC.releaseReg: bad reg"

initFreeRegs :: Platform -> FreeRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform :: Platform
platform = (FreeRegs -> RealReg -> FreeRegs)
-> FreeRegs -> [RealReg] -> FreeRegs
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 cls :: RegClass
cls (FreeRegs g :: Word32
g f :: Word32
f)
    | RegClass
RcDouble <- RegClass
cls = Word32 -> Word32 -> Int -> [RealReg]
forall a. (Num a, Bits a) => a -> a -> Int -> [RealReg]
go Word32
f (0x80000000) 63
    | RegClass
RcInteger <- RegClass
cls = Word32 -> Word32 -> Int -> [RealReg]
forall a. (Num a, Bits a) => a -> a -> Int -> [RealReg]
go Word32
g (0x80000000) 31
    | Bool
otherwise = String -> SDoc -> [RealReg]
forall a. HasCallStack => String -> SDoc -> a
pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (RegClass -> SDoc
forall a. Outputable a => a -> SDoc
ppr RegClass
cls)
    where
        go :: a -> a -> Int -> [RealReg]
go _ 0 _ = []
        go x :: a
x m :: a
m i :: Int
i | a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Int -> RealReg
RealRegSingle Int
i RealReg -> [RealReg] -> [RealReg]
forall a. a -> [a] -> [a]
: (a -> a -> Int -> [RealReg]
go a
x (a
m a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 1) (Int -> [RealReg]) -> Int -> [RealReg]
forall a b. (a -> b) -> a -> b
$! Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
                 | Bool
otherwise    = a -> a -> Int -> [RealReg]
go a
x (a
m a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 1) (Int -> [RealReg]) -> Int -> [RealReg]
forall a b. (a -> b) -> a -> b
$! Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1

allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r :: Int
r) (FreeRegs g :: Word32
g f :: Word32
f)
    | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 (1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 (1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
r)) Word32
f

allocateReg _ _
        = String -> FreeRegs
forall a. String -> a
panic "RegAlloc.Linear.PPC.allocateReg: bad reg"