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

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index c897a4d..330a410 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -16,28 +16,29 @@ module RegAlloc.Graph.SpillCost (
 
 where
 
+import RegAlloc.Liveness
+import Instruction
+import RegClass
+import Reg
+
 import GraphBase
-import RegLiveness
-import RegAllocInfo
-import Instrs
-import Regs
-import BlockId
-import Cmm
 
+import BlockId
+import OldCmm
 import UniqFM
 import UniqSet
+import Digraph		(flattenSCCs)
 import Outputable
 import State
 
 import Data.List	(nub, minimumBy)
 import Data.Maybe
-import Control.Monad
 
 type SpillCostRecord
- = 	( Reg	-- register name
-	, Int	-- number of writes to this reg
-	, Int	-- number of reads from this reg
-	, Int)	-- number of instrs this reg was live on entry to
+ = 	( VirtualReg	-- register name
+	, Int		-- number of writes to this reg
+	, Int		-- number of reads from this reg
+	, Int)		-- number of instrs this reg was live on entry to
 
 type SpillCostInfo
 	= UniqFM SpillCostRecord
@@ -62,61 +63,62 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 --	and the number of instructions it was live on entry to (lifetime)
 --
 slurpSpillCostInfo
-	:: LiveCmmTop
+	:: (Outputable instr, Instruction instr)
+	=> LiveCmmTop instr
 	-> SpillCostInfo
 
 slurpSpillCostInfo cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
-	countCmm (CmmProc info _ _ (ListGraph blocks))
-		= mapM_ (countComp info) blocks
-
-	countComp info (BasicBlock _ blocks)
-		= mapM_ (countBlock info) blocks
+	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 _ _ blockLive	<- info
-		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
-		= countLIs rsLiveEntry instrs
+		| LiveInfo _ _ (Just blockLive) _ <- info
+		, Just rsLiveEntry  <- mapLookup blockId blockLive
+		, rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
+		= countLIs rsLiveEntry_virt instrs
 
 		| otherwise
-		= error "RegLiveness.slurpSpillCostInfo: bad block"
+		= error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
 
 	countLIs _      []
 		= return ()
 
 	-- skip over comment and delta pseudo instrs
-	countLIs rsLive (Instr instr Nothing : lis)
-		| COMMENT{}	<- instr
-		= countLIs rsLive lis
-
-		| DELTA{}	<- instr
+	countLIs rsLive (LiveInstr instr Nothing : lis)
+		| isMetaInstr instr
 		= countLIs rsLive lis
 
 		| otherwise
 		= pprPanic "RegSpillCost.slurpSpillCostInfo"
 			(text "no liveness information on instruction " <> ppr instr)
 
-	countLIs rsLiveEntry (Instr instr (Just live) : lis)
+	countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
 	 = do
 		-- increment the lifetime counts for regs live on entry to this instr
 		mapM_ incLifetime $ uniqSetToList rsLiveEntry
 
 		-- increment counts for what regs were read/written from
-		let (RU read written)	= regUsage instr
-		mapM_ incUses	$ filter (not . isRealReg) $ nub read
-		mapM_ incDefs 	$ filter (not . isRealReg) $ nub written
+		let (RU read written)	= regUsageOfInstr instr
+		mapM_ incUses	$ catMaybes $ map takeVirtualReg $ nub read
+		mapM_ incDefs 	$ catMaybes $ map takeVirtualReg $ nub written
 
 		-- compute liveness for entry to next instruction.
+		let liveDieRead_virt	= takeVirtuals (liveDieRead  live)
+		let liveDieWrite_virt	= takeVirtuals (liveDieWrite live)
+		let liveBorn_virt	= takeVirtuals (liveBorn     live)
+
 	 	let rsLiveAcross
-			= rsLiveEntry `minusUniqSet` (liveDieRead live)
+			= rsLiveEntry `minusUniqSet` liveDieRead_virt
 
 	 	let rsLiveNext
-			= (rsLiveAcross `unionUniqSets` (liveBorn     live))
-				        `minusUniqSet` (liveDieWrite live)
+			= (rsLiveAcross `unionUniqSets` liveBorn_virt)
+				        `minusUniqSet`  liveDieWrite_virt
 
 	 	countLIs rsLiveNext lis
 
@@ -125,12 +127,19 @@ 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
 	:: SpillCostInfo
-	-> Graph Reg RegClass Reg
-	-> Reg
+	-> Graph VirtualReg RegClass RealReg
+	-> VirtualReg
 
 chooseSpill info graph
  = let	cost	= spillCost_length info graph
@@ -206,19 +215,20 @@ spillCost_chaitin info graph reg
 -- Just spill the longest live range.
 spillCost_length
 	:: SpillCostInfo
-	-> Graph Reg RegClass Reg
-	-> Reg
+	-> Graph VirtualReg RegClass RealReg
+	-> VirtualReg
 	-> Float
 
 spillCost_length info _ reg
 	| lifetime <= 1		= 1/0
 	| otherwise		= 1 / fromIntegral lifetime
 	where (_, _, _, lifetime)
-		= fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
+		= fromMaybe (reg, 0, 0, 0) 
+		$ lookupUFM info reg
 
 
 
-lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (Reg, Int)
+lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
 lifeMapFromSpillCostInfo info
  	= listToUFM
 	$ map (\(r, _, _, life)	-> (r, (r, life)))
@@ -226,11 +236,20 @@ lifeMapFromSpillCostInfo info
 
 
 -- | Work out the degree (number of neighbors) of this node which have the same class.
-nodeDegree :: Graph Reg RegClass Reg -> Reg -> Int
-nodeDegree graph reg
+nodeDegree 
+	:: (VirtualReg -> RegClass)
+	-> Graph VirtualReg RegClass RealReg 
+	-> VirtualReg 
+	-> Int
+
+nodeDegree classOfVirtualReg graph reg
 	| Just node	<- lookupUFM (graphMap graph) reg
-	, virtConflicts	<- length 	$ filter (\r -> regClass r == regClass reg)
-					$ uniqSetToList $ nodeConflicts node
+
+	, virtConflicts	<- length 	
+			$ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
+			$ uniqSetToList 
+			$ nodeConflicts node
+
 	= virtConflicts + sizeUniqSet (nodeExclusions node)
 
 	| otherwise
@@ -238,12 +257,21 @@ nodeDegree graph reg
 
 
 -- | Show a spill cost record, including the degree from the graph and final calulated spill cos
-pprSpillCostRecord :: Graph Reg RegClass Reg -> SpillCostRecord -> SDoc
-pprSpillCostRecord graph (reg, uses, defs, life)
+pprSpillCostRecord 
+	:: (VirtualReg -> RegClass)
+	-> (Reg -> SDoc)
+	-> Graph VirtualReg RegClass RealReg 
+	-> SpillCostRecord 
+	-> SDoc
+
+pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
  	=  hsep
-	[ ppr reg
+	[ pprReg (RegVirtual reg)
 	, ppr uses
 	, ppr defs
 	, ppr life
-	, ppr $ nodeDegree graph reg
-	, text $ show $ (fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg) :: Float) ]
+	, ppr $ nodeDegree regClass graph reg
+	, text $ show $ (fromIntegral (uses + defs) 
+			/ fromIntegral (nodeDegree regClass graph reg) :: Float) ]
+
+