FreeRegs.hs 1.32 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 16

import Data.Word
import Data.Bits

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

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

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

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

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

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

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

42 43 44 45
          | 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.
46

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

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