1 files changed, 13 insertions, 26 deletions

diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
index b1fc3c169e..69cf411751 100644
--- a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
@@ -21,15 +21,13 @@ module RegAlloc.Linear.StackMap (
 	StackSlot,
 	StackMap(..),
 	emptyStackMap,
-	getStackSlotFor
+        getStackSlotFor,
+        getStackUse
 )
 
 where
 
-import RegAlloc.Linear.FreeRegs
-
 import DynFlags
-import Outputable
 import UniqFM
 import Unique
 
@@ -40,7 +38,7 @@ type StackSlot = Int
 data StackMap 
 	= StackMap 
 	{ -- | The slots that are still available to be allocated.
-	  stackMapFreeSlots	:: [StackSlot]
+          stackMapNextFreeSlot  :: !Int
 
 	  -- | Assignment of vregs to stack slots.
 	, stackMapAssignment	:: UniqFM StackSlot }
@@ -48,7 +46,7 @@ data StackMap
 
 -- | An empty stack map, with all slots available.
 emptyStackMap :: DynFlags -> StackMap
-emptyStackMap dflags = StackMap [0 .. maxSpillSlots dflags] emptyUFM
+emptyStackMap _ = StackMap 0 emptyUFM
 
 
 -- | If this vreg unique already has a stack assignment then return the slot number,
@@ -56,24 +54,13 @@ emptyStackMap dflags = StackMap [0 .. maxSpillSlots dflags] emptyUFM
 --
 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)
+getStackSlotFor fs@(StackMap _ reserved) reg
+  | Just slot <- lookupUFM reserved reg  =  (fs, slot)
+
+getStackSlotFor (StackMap freeSlot reserved) reg =
+    (StackMap (freeSlot+1) (addToUFM reserved reg freeSlot), freeSlot)
+
+-- | Return the number of stack slots that were allocated
+getStackUse :: StackMap -> Int
+getStackUse (StackMap freeSlot _) = freeSlot