From: Ben.Lippmeier@anu.edu.au <unknown>
Date: Thu, 17 Sep 2009 04:39:37 +0000 (+0000)
Subject: NCG: Allow the liveness map in a LiveInfo to be Nothing
X-Git-Tag: 2010-11-18~681
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=37802abf7457723624097d8b78d5ec53a68d7f09

NCG: Allow the liveness map in a LiveInfo to be Nothing
---

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 9de48d5..58e9580 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -80,7 +80,7 @@ slurpSpillCostInfo cmm
 	-- 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
+		| LiveInfo _ _ (Just blockLive)	<- info
 		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
 
 		, rsLiveEntry_virt	<- mapUniqSet (\(RegVirtual vr) -> vr) 
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 7201207..3eab785 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -137,7 +137,7 @@ regAlloc (CmmProc (LiveInfo info _ _) lbl params (ListGraph []))
 		 , Nothing )
 	
 regAlloc (CmmProc static lbl params (ListGraph comps))
-	| LiveInfo info (Just first_id) block_live	<- static
+	| LiveInfo info (Just first_id) (Just block_live)	<- static
 	= do	
  		-- do register allocation on each component.
 		(final_blocks, stats)
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 0c289c1..94277f6 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -103,9 +103,9 @@ 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
-		(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
 
 -- | A basic block with liveness information.
 type LiveBasicBlock instr
@@ -228,7 +228,7 @@ slurpConflicts live
 		= foldl' (slurpBlock info) rs blocks
 
 	slurpBlock info rs (BasicBlock blockId instrs)	
-		| LiveInfo _ _ blockLive	<- info
+		| LiveInfo _ _ (Just blockLive)	<- info
 		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
 		, (conflicts, moves)		<- slurpLIs rsLiveEntry rs instrs
 		= (consBag rsLiveEntry conflicts, moves)
@@ -464,14 +464,18 @@ patchEraseLive patchF cmm
 	patchCmm cmm@CmmData{}	= cmm
 
 	patchCmm (CmmProc info label params (ListGraph comps))
-	 | LiveInfo static id blockMap	<- info
+	 | LiveInfo static id (Just blockMap)	<- info
 	 = let 	
 	 	patchRegSet set	= mkUniqSet $ map patchF $ uniqSetToList set
 		blockMap'	= mapBlockEnv patchRegSet blockMap
 
-		info'		= LiveInfo static id blockMap'
+		info'		= LiveInfo static id (Just blockMap')
 	   in	CmmProc info' label params $ ListGraph $ map patchComp comps
 
+	 | otherwise
+	 = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
+
+
 	patchComp (BasicBlock id blocks)
 		= BasicBlock id $ map patchBlock blocks
 
@@ -531,6 +535,35 @@ patchRegsLiveInstr patchF li
 	 -> RELOAD slot (patchF reg)
 
 
+--------------------------------------------------------------------------------
+-- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
+{-
+natCmmTopToLive 
+	:: NatCmmTop instr
+	-> LiveCmmTop instr
+
+natCmmTopToLive cmm@(CmmData _ _)
+	= cmm
+
+natCmmTopToLive (CmmProc info lbl params (ListGraph []))
+	= CmmProc (LiveInfo info Nothing emptyBlockEnv)
+		lbl params (ListGraph []))
+
+natCmmTopToLive (CmmProc info lbl params (ListGraph blocks))
+ = let	first_id		= blockId first
+	sccs			= sccBlocks blocks
+
+	liveBlocks
+	 = map (\scc -> case scc of
+			AcyclicSCC  b@(BasicBlock l _)		-> BasicBlock l [cmmBlockToLive b]	
+			CyclicSCC  bs@(BasicBlock l _ : _)	-> BasicBlock l (map cmmBlockToLive bs)
+			CyclicSCC  []	
+			 -> panic "RegLiveNess.natCmmTopToLive: no blocks in scc list")
+		sccs
+
+   in	CmmProc (LiveInfo info (Just first_id) ???
+-}
+
 ---------------------------------------------------------------------------------
 -- Annotate code with register liveness information
 --
@@ -544,7 +577,7 @@ regLiveness (CmmData i d)
 
 regLiveness (CmmProc info lbl params (ListGraph []))
 	= returnUs $ CmmProc
-			(LiveInfo info Nothing emptyBlockEnv)
+			(LiveInfo info Nothing (Just emptyBlockEnv))
 			lbl params (ListGraph [])
 
 regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
@@ -560,7 +593,7 @@ regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
 			 -> panic "RegLiveness.regLiveness: no blocks in scc list")
 		 $ ann_sccs
 
-   in	returnUs $ CmmProc (LiveInfo info (Just first_id) block_live)
+   in	returnUs $ CmmProc (LiveInfo info (Just first_id) (Just block_live))
 			   lbl params (ListGraph liveBlocks)