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