{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Free regs map for i386
module GHC.CmmToAsm.Reg.Linear.X86 where

import GHC.Prelude

import GHC.CmmToAsm.X86.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.Utils.Panic
import GHC.Platform
import GHC.Utils.Outputable

import Data.Word

newtype FreeRegs = FreeRegs 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,FreeRegs -> SDoc
forall a. (a -> SDoc) -> Outputable a
ppr :: FreeRegs -> SDoc
$cppr :: FreeRegs -> SDoc
Outputable)

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

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

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

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

          | Bool
otherwise
          = Word32 -> RegNo -> [RealReg]
go (Word32
n forall a. Bits a => a -> RegNo -> a
`shiftR` RegNo
1) forall a b. (a -> b) -> a -> b
$! (RegNo
mforall a. Num a => a -> a -> a
+RegNo
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 RegNo
r) (FreeRegs Word32
f)
        = Word32 -> FreeRegs
FreeRegs (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))

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