FreeRegs.hs 1.52 KB
Newer Older
1

Ian Lynagh's avatar
Ian Lynagh committed
2 3 4 5 6 7 8
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

9 10 11 12
-- | Free regs map for i386 and x86_64
module RegAlloc.Linear.X86.FreeRegs
where

13 14 15
import X86.Regs
import RegClass
import Reg
16
import Panic
17
import Platform
18 19 20 21 22

import Data.Word
import Data.Bits

type FreeRegs 
23
#ifdef i386_TARGET_ARCH
24
	= Word32
25 26 27
#else
	= Word64
#endif
28 29 30 31

noFreeRegs :: FreeRegs
noFreeRegs = 0

32 33 34 35 36 37
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) f 
	= f .|. (1 `shiftL` n)

releaseReg _ _	
	= panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
38

39 40 41
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
	= foldr releaseReg noFreeRegs (allocatableRegs platform)
42

43 44
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazilly
getFreeRegs platform cls f = go f 0
45 46 47

  where go 0 _ = []
        go n m 
48
	  | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
49
	  = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
50 51 52 53 54 55

	  | otherwise
	  = go (n `shiftR` 1) $! (m+1)
	-- ToDo: there's no point looking through all the integer registers
	-- in order to find a floating-point one.

56 57
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) f 
58
        = f .&. complement (1 `shiftL` r)
59 60 61

allocateReg _ _
	= panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
62 63