X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegLiveness.hs;h=50af2eb7a0f11f85b52c15419cd8340f847a13b3;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=e18931caa234b07fc7955b6963168bf289fe8b77;hpb=86f1f4e0748ba1146cf74786af38a68a88164e2f;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index e18931c..50af2eb 100644
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -23,7 +23,6 @@ module RegLiveness (
 	spillNatBlock,
 	slurpConflicts,
 	slurpReloadCoalesce,
-	lifetimeCount,
 	eraseDeltasLive,
 	patchEraseLive,
 	patchRegsLiveInstr,
@@ -31,8 +30,6 @@ module RegLiveness (
 
   ) where
 
-#include "HsVersions.h"
-
 import MachRegs
 import MachInstrs
 import PprMach
@@ -47,6 +44,7 @@ import UniqFM
 import UniqSupply
 import Bag
 import State
+import FastString
 
 import Data.List
 import Data.Maybe
@@ -113,9 +111,9 @@ instance Outputable LiveInstr where
 	 =  ppr instr
 		$$ (nest 8
 			$ vcat
-			[ pprRegs (ptext SLIT("# born:    ")) (liveBorn live)
-			, pprRegs (ptext SLIT("# r_dying: ")) (liveDieRead live)
-			, pprRegs (ptext SLIT("# w_dying: ")) (liveDieWrite live) ]
+			[ pprRegs (ptext (sLit "# born:    ")) (liveBorn live)
+			, pprRegs (ptext (sLit "# r_dying: ")) (liveDieRead live)
+			, pprRegs (ptext (sLit "# w_dying: ")) (liveDieWrite live) ]
 		    $+$ space)
 
 	 where 	pprRegs :: SDoc -> RegSet -> SDoc
@@ -206,7 +204,7 @@ slurpConflicts live
 		= (consBag rsLiveEntry conflicts, moves)
 
 		| otherwise
-		= error "RegLiveness.slurpBlock: bad block"
+		= panic "RegLiveness.slurpBlock: bad block"
 
 	slurpLIs rsLive (conflicts, moves) []
 		= (consBag rsLive conflicts, moves)
@@ -381,48 +379,6 @@ spillNatBlock (BasicBlock i is)
 	 =	spillNat (instr : acc) instrs
 
 
--- | Slurp out a map of how many times each register was live upon entry to an instruction.
-
-lifetimeCount
-	:: LiveCmmTop
-	-> UniqFM (Reg, Int)	-- ^ reg -> (reg, count)
-
-lifetimeCount cmm
-	= countCmm emptyUFM cmm
- where
-	countCmm fm  CmmData{}		= fm
-	countCmm fm (CmmProc info _ _ (ListGraph blocks))
-		= foldl' (countComp info) fm blocks
-		
-	countComp info fm (BasicBlock _ blocks)
-		= foldl' (countBlock info) fm blocks
-		
- 	countBlock info fm (BasicBlock blockId instrs)
-		| LiveInfo _ _ blockLive	<- info
-		, Just rsLiveEntry		<- lookupUFM blockLive blockId
-		= countLIs rsLiveEntry fm instrs
-
-		| otherwise
-		= error "RegLiveness.countBlock: bad block"
-		
-	countLIs _      fm []				= fm
-	countLIs rsLive fm (Instr _ Nothing : lis)	= countLIs rsLive fm lis
-	
-	countLIs rsLiveEntry fm (Instr _ (Just live) : lis)
-	 = let
-	 	rsLiveAcross	= rsLiveEntry `minusUniqSet` (liveDieRead live)
-
-	 	rsLiveNext 	= (rsLiveAcross `unionUniqSets` (liveBorn     live))
-					         `minusUniqSet` (liveDieWrite live)
-
-		add r fm	= addToUFM_C
-					(\(r1, l1) (_, l2) -> (r1, l1 + l2))
-					fm r (r, 1)
-
-		fm'		= foldUniqSet add fm rsLiveEntry
-	   in	countLIs rsLiveNext fm' lis
-	   
-
 -- | Erase Delta instructions.
 
 eraseDeltasLive :: LiveCmmTop -> LiveCmmTop
@@ -601,7 +557,7 @@ livenessSCCs blockmap done
 	          concatMap tail $
 	          groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
 	          iterate (\(a, _) -> f a b) $
-	          (a, error "RegisterAlloc.livenessSCCs")
+	          (a, panic "RegLiveness.livenessSCCs")
 
 
             linearLiveness :: BlockMap RegSet -> [NatBasicBlock]