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
data FreeRegs = FreeRegs !Word32 !Word32
deriving( RegNo -> FreeRegs -> ShowS
[FreeRegs] -> ShowS
FreeRegs -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeRegs] -> ShowS
$cshowList :: [FreeRegs] -> ShowS
show :: FreeRegs -> String
$cshow :: FreeRegs -> String
showsPrec :: RegNo -> FreeRegs -> ShowS
$cshowsPrec :: RegNo -> FreeRegs -> ShowS
Show )
instance Outputable FreeRegs where
ppr :: FreeRegs -> SDoc
ppr = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> RegNo
31 = Word32 -> Word32 -> FreeRegs
FreeRegs Word32
g (Word32
f forall a. Bits a => a -> a -> a
.|. (Word32
1 forall a. Bits a => a -> RegNo -> a
`shiftL` (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32)))
| Bool
otherwise = Word32 -> Word32 -> FreeRegs
FreeRegs (Word32
g forall a. Bits a => a -> a -> a
.|. (Word32
1 forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
r)) Word32
f
releaseReg RealReg
_ FreeRegs
_
= forall a. String -> a
panic String
"RegAlloc.Linear.PPC.releaseReg: bad reg"
initFreeRegs :: Platform -> FreeRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs Platform
platform = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (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]
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs RegClass
cls (FreeRegs Word32
g Word32
f)
| RegClass
RcFloat <- RegClass
cls = []
| RegClass
RcDouble <- RegClass
cls = forall {t}. (Num t, Bits t) => t -> t -> RegNo -> [RealReg]
go Word32
f (Word32
0x80000000) RegNo
63
| RegClass
RcInteger <- RegClass
cls = 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 forall a. Bits a => a -> a -> a
.&. t
m forall a. Eq a => a -> a -> Bool
/= t
0 = RegNo -> RealReg
RealRegSingle RegNo
i forall a. a -> [a] -> [a]
: (t -> t -> RegNo -> [RealReg]
go t
x (t
m forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) forall a b. (a -> b) -> a -> b
$! RegNo
iforall a. Num a => a -> a -> a
-RegNo
1)
| Bool
otherwise = t -> t -> RegNo -> [RealReg]
go t
x (t
m forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) forall a b. (a -> b) -> a -> b
$! RegNo
iforall 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 forall a. Ord a => a -> a -> Bool
> RegNo
31 = Word32 -> Word32 -> FreeRegs
FreeRegs Word32
g (Word32
f forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (Word32
1 forall a. Bits a => a -> RegNo -> a
`shiftL` (RegNo
r forall a. Num a => a -> a -> a
- RegNo
32)))
| Bool
otherwise = Word32 -> Word32 -> FreeRegs
FreeRegs (Word32
g forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (Word32
1 forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
r)) Word32
f
allocateReg RealReg
_ FreeRegs
_
= forall a. String -> a
panic String
"RegAlloc.Linear.PPC.allocateReg: bad reg"