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