X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpillCost.hs;h=330a410312f9d2d631707c60651c3b7b5ed8349b;hb=f537dd87c4a07526e2b1fc1bd1c125d652833641;hp=97995871af92d005492783d681585a42b49fb5a6;hpb=e17cf7ff32778f4e6b3622855f25426251e843d6;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 9799587..330a410 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -24,7 +24,7 @@ import Reg
 import GraphBase
 
 import BlockId
-import Cmm
+import OldCmm
 import UniqFM
 import UniqSet
 import Digraph		(flattenSCCs)
@@ -71,19 +71,16 @@ slurpSpillCostInfo cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
-	countCmm (CmmProc info _ _ sccs)
+	countCmm (CmmProc info _ sccs)
 		= mapM_ (countBlock info)
 		$ flattenSCCs sccs
 
 	-- lookup the regs that are live on entry to this block in
 	--	the info table from the CmmProc
  	countBlock info (BasicBlock blockId instrs)
-		| LiveInfo _ _ (Just blockLive)	<- info
-		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
-
-		, rsLiveEntry_virt	<- mapUniqSet (\(RegVirtual vr) -> vr) 
-					$  filterUniqSet isVirtualReg rsLiveEntry
-						
+		| LiveInfo _ _ (Just blockLive) _ <- info
+		, Just rsLiveEntry  <- mapLookup blockId blockLive
+		, rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
 		= countLIs rsLiveEntry_virt instrs
 
 		| otherwise
@@ -112,10 +109,6 @@ slurpSpillCostInfo cmm
 		mapM_ incDefs 	$ catMaybes $ map takeVirtualReg $ nub written
 
 		-- compute liveness for entry to next instruction.
-		let takeVirtuals set
-			= mapUniqSet (\(RegVirtual vr) -> vr)
-			$ filterUniqSet isVirtualReg set
-
 		let liveDieRead_virt	= takeVirtuals (liveDieRead  live)
 		let liveDieWrite_virt	= takeVirtuals (liveDieWrite live)
 		let liveBorn_virt	= takeVirtuals (liveBorn     live)
@@ -134,6 +127,13 @@ slurpSpillCostInfo cmm
 	incLifetime reg	= modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
 
 
+takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
+takeVirtuals set = mapUniqSet get_virtual
+		$ filterUniqSet isVirtualReg set
+  where
+   get_virtual (RegVirtual vr) = vr 
+   get_virtual _ = panic "getVirt" 
+
 -- | Choose a node to spill from this graph
 
 chooseSpill