X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FLiveness.hs;fp=compiler%2FnativeGen%2FRegAlloc%2FLiveness.hs;h=903fa4c577ef9b564aa50a44d4f3be7e2f075635;hp=0efc6f55f300bf9e36b454097fb1204f0d512760;hb=09732d3c8ba3b8ab3ebfc5596cc8fdd7f2bb100f;hpb=2ea237998122126f092e3d39482b2f0a95fe0a99

diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 0efc6f5..903fa4c 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -18,7 +18,7 @@ module RegAlloc.Liveness (
 	LiveInfo (..),
 	LiveBasicBlock,
 
-	mapBlockTop, 	mapBlockTopM,
+	mapBlockTop, 	mapBlockTopM, 	mapSCCM,
 	mapGenBlockTop,	mapGenBlockTopM,
 	stripLive,
 	stripLiveBlock,
@@ -31,8 +31,6 @@ module RegAlloc.Liveness (
 	regLiveness,
 	natCmmTopToLive
   ) where
-
-
 import Reg
 import Instruction
 
@@ -52,6 +50,9 @@ import FastString
 
 import Data.List
 import Data.Maybe
+import Data.Map			(Map)
+import Data.Set			(Set)
+import qualified Data.Map	as Map
 
 -----------------------------------------------------------------------------
 type RegSet = UniqSet Reg
@@ -160,9 +161,11 @@ data Liveness
 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
 data LiveInfo
 	= LiveInfo
-		[CmmStatic]			-- cmm static stuff
-		(Maybe BlockId)			-- id of the first block
-		(Maybe (BlockMap RegSet))	-- argument locals live on entry to this block
+		[CmmStatic]				-- cmm static stuff
+		(Maybe BlockId)				-- id of the first block
+		(Maybe (BlockMap RegSet))		-- argument locals live on entry to this block
+		(Map BlockId (Set Int))			-- stack slots live on entry to this block
+
 
 -- | A basic block with liveness information.
 type LiveBasicBlock instr
@@ -212,10 +215,11 @@ instance Outputable instr
 		 | otherwise		= name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
 
 instance Outputable LiveInfo where
-	ppr (LiveInfo static firstId liveOnEntry)
+	ppr (LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry)
 		=  (vcat $ map ppr static)
-		$$ text "# firstId     = " <> ppr firstId
-		$$ text "# liveOnEntry = " <> ppr liveOnEntry
+		$$ text "# firstId          = " <> ppr firstId
+		$$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
+		$$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
 
 
 
@@ -299,9 +303,9 @@ slurpConflicts live
 		= foldl'  (slurpBlock info) rs bs
 
 	slurpBlock info rs (BasicBlock blockId instrs)	
-		| LiveInfo _ _ (Just blockLive)	<- info
-		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
-		, (conflicts, moves)		<- slurpLIs rsLiveEntry rs instrs
+		| LiveInfo _ _ (Just blockLive)	_ <- info
+		, Just rsLiveEntry		  <- lookupBlockEnv blockLive blockId
+		, (conflicts, moves)		  <- slurpLIs rsLiveEntry rs instrs
 		= (consBag rsLiveEntry conflicts, moves)
 
 		| otherwise
@@ -466,7 +470,7 @@ stripLive live
 
  where	stripCmm (CmmData sec ds)	= CmmData sec ds
 
- 	stripCmm (CmmProc (LiveInfo info (Just first_id) _) label params sccs)
+ 	stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label params sccs)
 	 = let	final_blocks	= flattenSCCs sccs
 		
 		-- make sure the block that was first in the input list
@@ -479,7 +483,7 @@ stripLive live
                           (ListGraph $ map stripLiveBlock $ first' : rest')
 
 	-- procs used for stg_split_markers don't contain any blocks, and have no first_id.
-	stripCmm (CmmProc (LiveInfo info Nothing _) label params [])
+	stripCmm (CmmProc (LiveInfo info Nothing _ _) label params [])
 	 =	CmmProc info label params (ListGraph [])
 
 	-- If the proc has blocks but we don't know what the first one was, then we're dead.
@@ -540,7 +544,6 @@ eraseDeltasLive cmm
 -- | Patch the registers in this code according to this register mapping.
 --	also erase reg -> reg moves when the reg is the same.
 --	also erase reg -> reg moves when the destination dies in this instr.
-
 patchEraseLive
 	:: Instruction instr
 	=> (Reg -> Reg)
@@ -552,12 +555,12 @@ patchEraseLive patchF cmm
 	patchCmm cmm@CmmData{}	= cmm
 
 	patchCmm (CmmProc info label params sccs)
-	 | LiveInfo static id (Just blockMap)	<- info
+	 | LiveInfo static id (Just blockMap) mLiveSlots <- info
 	 = let 	
 	 	patchRegSet set	= mkUniqSet $ map patchF $ uniqSetToList set
 		blockMap'	= mapBlockEnv patchRegSet blockMap
 
-		info'		= LiveInfo static id (Just blockMap')
+		info'		= LiveInfo static id (Just blockMap') mLiveSlots
 	   in	CmmProc info' label params $ map patchSCC sccs
 
 	 | otherwise
@@ -628,7 +631,7 @@ natCmmTopToLive (CmmData i d)
 	= CmmData i d
 
 natCmmTopToLive (CmmProc info lbl params (ListGraph []))
-	= CmmProc (LiveInfo info Nothing Nothing)
+	= CmmProc (LiveInfo info Nothing Nothing Map.empty)
 		  lbl params []
 
 natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
@@ -638,7 +641,7 @@ natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
 					BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
 			$ sccs
 				
-   in	CmmProc (LiveInfo info (Just first_id) Nothing)
+   in	CmmProc (LiveInfo info (Just first_id) Nothing Map.empty)
 		lbl params sccsLive
 
 
@@ -668,16 +671,16 @@ regLiveness (CmmData i d)
 	= returnUs $ CmmData i d
 
 regLiveness (CmmProc info lbl params [])
-	| LiveInfo static mFirst _	<- info
+	| LiveInfo static mFirst _ _	<- info
 	= returnUs $ CmmProc
-			(LiveInfo static mFirst (Just emptyBlockEnv))
+			(LiveInfo static mFirst (Just emptyBlockEnv) Map.empty)
 			lbl params []
 
 regLiveness (CmmProc info lbl params sccs)
-	| LiveInfo static mFirst _	<- info
+	| LiveInfo static mFirst _ liveSlotsOnEntry	<- info
 	= let	(ann_sccs, block_live)	= computeLiveness sccs
 
-   	  in	returnUs $ CmmProc (LiveInfo static mFirst (Just block_live))
+   	  in	returnUs $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
 			   lbl params ann_sccs