FreeRegs.hs 1.33 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 8
import X86.Regs
import RegClass
import Reg
9
import Panic
10
import Platform
11 12 13

import Data.Word
import Data.Bits
14
import Data.Foldable (foldl')
15

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

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

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

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

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

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

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

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

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

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