-- | Free regs map for SPARC
module RegAlloc.Linear.SPARC.FreeRegs
where

import SPARC.Regs
import SPARC.RegPlate
import RegClass
import Reg

import Outputable
import FastBool

import Data.Word
import Data.Bits
-- import Data.List


--------------------------------------------------------------------------------
-- SPARC is like PPC, except for twinning of floating point regs.
--	When we allocate a double reg we must take an even numbered
--	float reg, as well as the one after it.


-- Holds bitmaps showing what registers are currently allocated.
--	The float and double reg bitmaps overlap, but we only alloc
--	float regs into the float map, and double regs into the double map.
--
--	Free regs have a bit set in the corresponding bitmap.
--
data FreeRegs 
	= FreeRegs 
		!Word32 	-- int    reg bitmap	regs  0..31
		!Word32 	-- float  reg bitmap	regs 32..63
		!Word32		-- double reg bitmap	regs 32..63

instance Show FreeRegs where
	show = showFreeRegs

-- | A reg map where no regs are free to be allocated.
noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0 0 0


-- | The initial set of free regs.
initFreeRegs :: FreeRegs
initFreeRegs 
 = 	foldr releaseReg noFreeRegs allocatableRegs

			
-- | Get all the free registers of this class.
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]	-- lazilly
getFreeRegs cls (FreeRegs g f d)
	| RcInteger <- cls = map RealRegSingle			$ go 1 g 1 0  
	| RcFloat   <- cls = map RealRegSingle			$ go 1 f 1 32 
	| RcDouble  <- cls = map (\i -> RealRegPair i (i+1)) 	$ go 2 d 1 32 
	| otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
	where
		go _    _      0    _
			= []

	        go step bitmap mask ix 
			| bitmap .&. mask /= 0 
			= ix : (go step bitmap (mask `shiftL` step) $! ix + step) 

        	       	| otherwise    
			= go step bitmap (mask `shiftL` step) $! ix + step


-- | Grab a register.
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg 
	 reg@(RealRegSingle r)
	     (FreeRegs g f d)

	-- can't allocate free regs
	| not $ isFastTrue (freeReg r)
	= pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
	
	-- a general purpose reg
	| r <= 31
	= let	mask	= complement (bitMask r)
	  in 	FreeRegs 
			(g .&. mask) 
			f 
			d

	-- a float reg
	| r >= 32, r <= 63
	= let	mask	= complement (bitMask (r - 32))
	
		-- the mask of the double this FP reg aliases
		maskLow = if r `mod` 2 == 0
				then complement (bitMask (r - 32))
				else complement (bitMask (r - 32 - 1))
	  in	FreeRegs
	  		g
			(f .&. mask)
			(d .&. maskLow)

	| otherwise
	= pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
			
allocateReg
	 reg@(RealRegPair r1 r2)
             (FreeRegs g f d)
	
  	| r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
	, r2 >= 32, r2 <= 63
	= let	mask1	= complement (bitMask (r1 - 32))
		mask2	= complement (bitMask (r2 - 32))
	  in
	  	FreeRegs
			g
			((f .&. mask1) .&. mask2)
			(d .&. mask1)
			
	| otherwise
	= pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
 


-- | Release a register from allocation.
--	The register liveness information says that most regs die after a C call, 
--	but we still don't want to allocate to some of them.
--
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg 
	 reg@(RealRegSingle r) 
	regs@(FreeRegs g f d)

	-- don't release pinned reg
	| not $ isFastTrue (freeReg r)
	= regs

	-- a general purpose reg
	| r <= 31	
	= let	mask	= bitMask r
	  in	FreeRegs (g .|. mask) f d

	-- a float reg
	| r >= 32, r <= 63
	= let	mask	= bitMask (r - 32)
		
		-- the mask of the double this FP reg aliases
		maskLow = if r `mod` 2 == 0
				then bitMask (r - 32)
				else bitMask (r - 32 - 1)
	  in	FreeRegs 
			g 
			(f .|. mask)
			(d .|. maskLow)

	| otherwise
	= pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
	
releaseReg 
	 reg@(RealRegPair r1 r2) 
	     (FreeRegs g f d)

	| r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
	, r2 >= 32, r2 <= 63
	= let	mask1	= bitMask (r1 - 32)
		mask2	= bitMask (r2 - 32)
	  in
	  	FreeRegs
			g
			((f .|. mask1) .|. mask2)
			(d .|. mask1)
			
	| otherwise
	= pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
	   


bitMask :: Int -> Word32
bitMask n	= 1 `shiftL` n


showFreeRegs :: FreeRegs -> String
showFreeRegs regs
 	=  "FreeRegs\n"
	++ "    integer: " ++ (show $ getFreeRegs RcInteger regs)	++ "\n"
	++ "      float: " ++ (show $ getFreeRegs RcFloat   regs)	++ "\n"
	++ "     double: " ++ (show $ getFreeRegs RcDouble  regs)	++ "\n"