compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs

   1
   2 -- | Free regs map for i386 and x86_64
   3 module RegAlloc.Linear.X86.FreeRegs
   4 where
   5
   6 import X86.Regs
   7 import RegClass
   8 import Reg
   9
  10 import Data.Word
  11 import Data.Bits
  12 import Data.List
  13
  14 type FreeRegs
  15         = Word32
  16
  17 noFreeRegs :: FreeRegs
  18 noFreeRegs = 0
  19
  20 releaseReg :: RegNo -> FreeRegs -> FreeRegs
  21 releaseReg n f = f .|. (1 `shiftL` n)
  22
  23 initFreeRegs :: FreeRegs
  24 initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
  25
  26 getFreeRegs :: RegClass -> FreeRegs -> [RegNo]  -- lazilly
  27 getFreeRegs cls f = go f 0
  28
  29   where go 0 _ = []
  30         go n m
  31           | n .&. 1 /= 0 && regClass (regSingle m) == cls
  32           = m : (go (n `shiftR` 1) $! (m+1))
  33
  34           | otherwise
  35           = go (n `shiftR` 1) $! (m+1)
  36         -- ToDo: there's no point looking through all the integer registers
  37         -- in order to find a floating-point one.
  38
  39 allocateReg :: RegNo -> FreeRegs -> FreeRegs
  40 allocateReg r f = f .&. complement (1 `shiftL` fromIntegral r)
  41
  42