FreeRegs.hs 1.45 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 18 19 20 21

import Data.Word
import Data.Bits

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

noFreeRegs :: FreeRegs
noFreeRegs = 0

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

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

initFreeRegs :: FreeRegs
39 40
initFreeRegs 
	= foldr releaseReg noFreeRegs allocatableRegs
41

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

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

	  | 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.

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

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