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 import Panic
  10
  11 import Data.Word
  12 import Data.Bits
  13 import Data.List
  14
  15 type FreeRegs
  16         = Word32
  17
  18 noFreeRegs :: FreeRegs
  19 noFreeRegs = 0
  20
  21 releaseReg :: RealReg -> FreeRegs -> FreeRegs
  22 releaseReg (RealRegSingle n) f
  23         = f .|. (1 `shiftL` n)
  24
  25 releaseReg _ _
  26         = panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
  27
  28 initFreeRegs :: FreeRegs
  29 initFreeRegs
  30         = foldr releaseReg noFreeRegs allocatableRegs
  31
  32 getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazilly
  33 getFreeRegs cls f = go f 0
  34
  35   where go 0 _ = []
  36         go n m
  37           | n .&. 1 /= 0 && classOfRealReg (RealRegSingle m) == cls
  38           = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
  39
  40           | otherwise
  41           = go (n `shiftR` 1) $! (m+1)
  42         -- ToDo: there's no point looking through all the integer registers
  43         -- in order to find a floating-point one.
  44
  45 allocateReg :: RealReg -> FreeRegs -> FreeRegs
  46 allocateReg (RealRegSingle r) f
  47         = f .&. complement (1 `shiftL` fromIntegral r)
  48
  49 allocateReg _ _
  50         = panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
  51
  52