module GHC.CmmToAsm.Reg.Linear.PPC where
import GHC.Prelude
import GHC.CmmToAsm.PPC.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
import Data.Word
import Data.Bits
data FreeRegs = FreeRegs !Word32 !Word32
deriving( Show )
instance Outputable FreeRegs where
ppr = text . show
noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle r) (FreeRegs g f)
| r > 31 = FreeRegs g (f .|. (1 `shiftL` (r 32)))
| otherwise = FreeRegs (g .|. (1 `shiftL` r)) f
releaseReg _ _
= panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs cls (FreeRegs g f)
| RcDouble <- cls = go f (0x80000000) 63
| RcInteger <- cls = go g (0x80000000) 31
| otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls)
where
go _ 0 _ = []
go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i1)
| otherwise = go x (m `shiftR` 1) $! i1
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) (FreeRegs g f)
| r > 31 = FreeRegs g (f .&. complement (1 `shiftL` (r 32)))
| otherwise = FreeRegs (g .&. complement (1 `shiftL` r)) f
allocateReg _ _
= panic "RegAlloc.Linear.PPC.allocateReg: bad reg"