X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpill.hs;h=4eabb3b0b479e6a2bafe97d191855843626ca9a2;hb=f8f0e76ad302fda30196ebc9230e5fcbc97be537;hp=d82e8a8fec4ff07e600623e5d554c1c03e088a07;hpb=09732d3c8ba3b8ab3ebfc5596cc8fdd7f2bb100f;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index d82e8a8..4eabb3b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -12,7 +12,7 @@ where
 import RegAlloc.Liveness
 import Instruction
 import Reg
-import Cmm	hiding (RegSet)
+import OldCmm hiding (RegSet)
 import BlockId
 
 import State
@@ -89,12 +89,12 @@ regSpill_top regSlotMap cmm
 	CmmData{}				
 	 -> return cmm
 
-	CmmProc info label params sccs
+	CmmProc info label sccs
 	 |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
 	 -> do	
 		-- We should only passed Cmms with the liveness maps filled in,  but we'll
 		-- create empty ones if they're not there just in case.
-		let liveVRegsOnEntry	= fromMaybe emptyBlockEnv mLiveVRegsOnEntry
+		let liveVRegsOnEntry	= fromMaybe mapEmpty mLiveVRegsOnEntry
 		
 		-- The liveVRegsOnEntry contains the set of vregs that are live on entry to
 		-- each basic block. If we spill one of those vregs we remove it from that
@@ -103,7 +103,7 @@ regSpill_top regSlotMap cmm
 		-- reload instructions after we've done a successful allocation.
 		let liveSlotsOnEntry' :: Map BlockId (Set Int)
 		    liveSlotsOnEntry'
-			= foldBlockEnv patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
+			= mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
 
 		let info'
 			= LiveInfo static firstId
@@ -113,7 +113,7 @@ regSpill_top regSlotMap cmm
 		-- Apply the spiller to all the basic blocks in the CmmProc.
 		sccs'		<- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
 
-		return	$ CmmProc info' label params sccs'
+		return	$ CmmProc info' label sccs'
 
  where	-- | Given a BlockId and the set of registers live in it, 
 	--   if registers in this block are being spilled to stack slots, 
@@ -292,12 +292,11 @@ type SpillM a	= State SpillS a
 
 newUnique :: SpillM Unique
 newUnique
- = do	us	<- gets stateUS
- 	case splitUniqSupply us of
-	 (us1, us2)
-	  -> do let uniq = uniqFromSupply us1
-	  	modify $ \s -> s { stateUS = us2 }
-		return uniq
+ = do   us      <- gets stateUS
+        case takeUniqFromSupply us of
+         (uniq, us')
+          -> do modify $ \s -> s { stateUS = us' }
+                return uniq
 
 accSpillSL (r1, s1, l1) (_, s2, l2)
 	= (r1, s1 + s2, l1 + l2)