-- | Free regs map for x86_64
module RegAlloc.Linear.X86_64.FreeRegs
where

import GhcPrelude

import X86.Regs
import RegClass
import Reg
import Panic
import Platform

import Data.Word
import Data.Bits

newtype FreeRegs = FreeRegs Word64
    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

noFreeRegs :: FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = Word64 -> FreeRegs
FreeRegs 0

releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n :: Int
n) (FreeRegs f :: Word64
f)
        = Word64 -> FreeRegs
FreeRegs (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
n))

releaseReg _ _
        = String -> FreeRegs
forall a. String -> a
panic "RegAlloc.Linear.X86_64.FreeRegs.releaseReg: no 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 :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
getFreeRegs platform :: Platform
platform cls :: RegClass
cls (FreeRegs f :: Word64
f) = Word64 -> Int -> [RealReg]
forall a. (Num a, Bits a) => a -> Int -> [RealReg]
go Word64
f 0

  where go :: a -> Int -> [RealReg]
go 0 _ = []
        go n :: a
n m :: Int
m
          | a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. 1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& Platform -> RealReg -> RegClass
classOfRealReg Platform
platform (Int -> RealReg
RealRegSingle Int
m) RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
== RegClass
cls
          = Int -> RealReg
RealRegSingle Int
m RealReg -> [RealReg] -> [RealReg]
forall a. a -> [a] -> [a]
: (a -> Int -> [RealReg]
go (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 1) (Int -> [RealReg]) -> Int -> [RealReg]
forall a b. (a -> b) -> a -> b
$! (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))

          | Bool
otherwise
          = a -> Int -> [RealReg]
go (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 1) (Int -> [RealReg]) -> Int -> [RealReg]
forall a b. (a -> b) -> a -> b
$! (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
        -- ToDo: there's no point looking through all the integer registers
        -- in order to find a floating-point one.

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

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