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