FreeRegs.hs 1.3 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 14

import Data.Word
import Data.Bits

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

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

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

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

28 29
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
30
        = foldr releaseReg noFreeRegs (allocatableRegs platform)
31

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

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

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

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

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