FreeRegs.hs 1.35 KB
Newer Older
1

ian@well-typed.com's avatar
ian@well-typed.com committed
2
-- | Free regs map for i386
3 4 5
module RegAlloc.Linear.X86.FreeRegs
where

6 7
import GhcPrelude

8 9 10
import X86.Regs
import RegClass
import Reg
11
import Panic
12
import Platform
13 14 15

import Data.Word
import Data.Bits
16
import Data.Foldable (foldl')
17

ian@well-typed.com's avatar
ian@well-typed.com committed
18 19
newtype FreeRegs = FreeRegs Word32
    deriving Show
20 21

noFreeRegs :: FreeRegs
ian@well-typed.com's avatar
ian@well-typed.com committed
22
noFreeRegs = FreeRegs 0
23

24
releaseReg :: RealReg -> FreeRegs -> FreeRegs
ian@well-typed.com's avatar
ian@well-typed.com committed
25 26
releaseReg (RealRegSingle n) (FreeRegs f)
        = FreeRegs (f .|. (1 `shiftL` n))
27

28
releaseReg _ _
ian@well-typed.com's avatar
ian@well-typed.com committed
29
        = panic "RegAlloc.Linear.X86.FreeRegs.releaseReg: no reg"
30

31 32
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
33
        = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
34

ian@well-typed.com's avatar
ian@well-typed.com committed
35 36
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
37 38

  where go 0 _ = []
39 40 41
        go n m
          | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
          = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
42

43 44 45 46
          | otherwise
          = go (n `shiftR` 1) $! (m+1)
        -- ToDo: there's no point looking through all the integer registers
        -- in order to find a floating-point one.
47

48
allocateReg :: RealReg -> FreeRegs -> FreeRegs
ian@well-typed.com's avatar
ian@well-typed.com committed
49 50
allocateReg (RealRegSingle r) (FreeRegs f)
        = FreeRegs (f .&. complement (1 `shiftL` r))
51 52

allocateReg _ _
53
        = panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
54