{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.CmmToAsm.Reg.Linear.X86_64 where
import GHC.Prelude
import GHC.CmmToAsm.X86.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Platform
import GHC.Utils.Outputable
import Data.Word
newtype FreeRegs = FreeRegs Word64
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,FreeRegs -> SDoc
(FreeRegs -> SDoc) -> Outputable FreeRegs
forall a. (a -> SDoc) -> Outputable a
$cppr :: FreeRegs -> SDoc
ppr :: FreeRegs -> SDoc
Outputable)
noFreeRegs :: FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = Word64 -> FreeRegs
FreeRegs Word64
0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle RegNo
n) (FreeRegs Word64
f)
= Word64 -> FreeRegs
FreeRegs (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
1 Word64 -> RegNo -> Word64
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
n))
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 :: Platform -> RegClass -> FreeRegs -> [RealReg]
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
getFreeRegs Platform
platform RegClass
cls (FreeRegs Word64
f) = Word64 -> RegNo -> [RealReg]
go Word64
f RegNo
0
where go :: Word64 -> RegNo -> [RealReg]
go Word64
0 RegNo
_ = []
go Word64
n RegNo
m
| Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 Bool -> Bool -> Bool
&& Platform -> RealReg -> RegClass
classOfRealReg Platform
platform (RegNo -> RealReg
RealRegSingle RegNo
m) RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
== RegClass
cls
= RegNo -> RealReg
RealRegSingle RegNo
m RealReg -> [RealReg] -> [RealReg]
forall a. a -> [a] -> [a]
: (Word64 -> RegNo -> [RealReg]
go (Word64
n Word64 -> RegNo -> Word64
forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) (RegNo -> [RealReg]) -> RegNo -> [RealReg]
forall a b. (a -> b) -> a -> b
$! (RegNo
mRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+RegNo
1))
| Bool
otherwise
= Word64 -> RegNo -> [RealReg]
go (Word64
n Word64 -> RegNo -> Word64
forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) (RegNo -> [RealReg]) -> RegNo -> [RealReg]
forall a b. (a -> b) -> a -> b
$! (RegNo
mRegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+RegNo
1)
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle RegNo
r) (FreeRegs Word64
f)
= Word64 -> FreeRegs
FreeRegs (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64
1 Word64 -> RegNo -> Word64
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
r))