-- | The assignment of virtual registers to stack slots

-- 	We have lots of stack slots. Memory-to-memory moves are a pain on most
-- 	architectures. Therefore, we avoid having to generate memory-to-memory moves
-- 	by simply giving every virtual register its own stack slot.

-- 	The StackMap stack map keeps track of virtual register - stack slot
-- 	associations and of which stack slots are still free. Once it has been
-- 	associated, a stack slot is never "freed" or removed from the StackMap again,
-- 	it remains associated until we are done with the current CmmProc.
--
module RegAlloc.Linear.StackMap (
	StackSlot,
	StackMap(..),
	emptyStackMap,
	getStackSlotFor
)

where

import RegAlloc.Linear.FreeRegs

import Outputable
import UniqFM
import Unique


-- | Identifier for a stack slot.
type StackSlot = Int

data StackMap 
	= StackMap 
	{ -- | The slots that are still available to be allocated.
	  stackMapFreeSlots	:: [StackSlot]

	  -- | Assignment of vregs to stack slots.
	, stackMapAssignment	:: UniqFM StackSlot }


-- | An empty stack map, with all slots available.
emptyStackMap :: StackMap
emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM


-- | If this vreg unique already has a stack assignment then return the slot number,
--	otherwise allocate a new slot, and update the map.
--
getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)

getStackSlotFor (StackMap [] _) _

        -- This happens all the time when trying to compile darcs' SHA1.hs, see Track #1993
	--	SHA1.lhs has also been added to the Crypto library on Hackage,
	--	so we see this all the time.  
	--
	-- It would be better to automatically invoke the graph allocator, or do something
	--	else besides panicing, but that's a job for a different day.  -- BL 2009/02
	--
	= panic $   "RegAllocLinear.getStackSlotFor: out of stack slots\n"
		++  "   If you are trying to compile SHA1.hs from the crypto library then this\n"
		++  "   is a known limitation in the linear allocator.\n"
		++  "\n"
		++  "   Try enabling the graph colouring allocator with -fregs-graph instead."
		++  "   You can still file a bug report if you like.\n"
		
getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
    case lookupUFM reserved reg of
    	Just slot	-> (fs, slot)
    	Nothing		-> (StackMap stack' (addToUFM reserved reg freeSlot), freeSlot)