X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FLinear%2FJoinToTargets.hs;h=903082fc26b2a3e6b1297fe9cdbc979947849693;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hp=7d2cbcd7a788dda02a86f822940935e29d173398;hpb=b04a210e26ca57242fd052f2aa91011a80b76299;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 7d2cbcd..903082f 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -23,7 +23,7 @@ import Instruction
 import Reg
 
 import BlockId
-import Cmm	hiding (RegSet)
+import OldCmm  hiding (RegSet)
 import Digraph
 import Outputable
 import Unique
@@ -86,7 +86,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 
 	-- adjust the current assignment to remove any vregs that are not live
 	-- on entry to the destination block.
-	let Just live_set 	= lookupBlockEnv block_live dest
+	let Just live_set 	= mapLookup dest block_live
 	let still_live uniq _ 	= uniq `elemUniqSet_Directly` live_set
 	let adjusted_assig	= filterUFM_Directly still_live assig
 
@@ -96,7 +96,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 			, not (elemUniqSet_Directly reg live_set)
 			, r 	     <- regsOfLoc loc ]
 
-	case lookupBlockEnv block_assig dest of
+	case mapLookup dest block_assig of
 	 Nothing 
 	  -> joinToTargets_first 
 	  		block_live new_blocks block_id instr dest dests
@@ -110,15 +110,15 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 
 -- this is the first time we jumped to this block.
 joinToTargets_first block_live new_blocks block_id instr dest dests
-	block_assig src_assig to_free
+	block_assig src_assig 
+	(to_free :: [RealReg])
 
  = do	-- free up the regs that are not live on entry to this block.
   	freeregs 	<- getFreeRegsR
 	let freeregs' 	= foldr releaseReg freeregs to_free 
 	
 	-- remember the current assignment on entry to this block.
-	setBlockAssigR (extendBlockEnv block_assig dest 
-				(freeregs', src_assig))
+	setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
 
 	joinToTargets' block_live new_blocks block_id instr dests
 
@@ -172,7 +172,7 @@ joinToTargets_again
 		--	A the end of the current block we will jump to the fixup one, 
 		--	then that will jump to our original destination.
 		fixup_block_id <- getUniqueR
-		let block = BasicBlock (BlockId fixup_block_id) 
+		let block = BasicBlock (mkBlockId fixup_block_id) 
 				$ fixUpInstrs ++ mkJumpInstr dest
 		
 {-		pprTrace
@@ -189,7 +189,7 @@ joinToTargets_again
 		 --	fixup block instead.
 		 _	-> let	instr'	=  patchJumpInstr instr 
 		 				(\bid -> if bid == dest 
-								then BlockId fixup_block_id 
+								then mkBlockId fixup_block_id 
 								else dest)
 						
 		 	   in	joinToTargets' block_live (block : new_blocks) block_id instr' dests
@@ -288,14 +288,15 @@ handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
 --	require a fixup.
 --
 handleComponent delta instr 
-	(CyclicSCC 	( (vreg, InReg sreg, [InReg dreg]) : rest))
+	(CyclicSCC 	( (vreg, InReg sreg, (InReg dreg: _)) : rest))
+        -- dest list may have more than one element, if the reg is also InMem.
  = do
 	-- spill the source into its slot
 	(instrSpill, slot) 
-			<- spillR (RealReg sreg) vreg
+			<- spillR (RegReal sreg) vreg
 
 	-- reload into destination reg
-	instrLoad	<- loadR (RealReg dreg) slot
+	instrLoad	<- loadR  (RegReal dreg) slot
 	
 	remainingFixUps <- mapM (handleComponent delta instr) 
 				(stronglyConnCompFromEdgedVerticesR rest)
@@ -320,15 +321,15 @@ makeMove
 
 makeMove _     vreg (InReg src) (InReg dst)
  = do	recordSpill (SpillJoinRR vreg)
- 	return	$ mkRegRegMoveInstr (RealReg src) (RealReg dst)
+ 	return	$ mkRegRegMoveInstr (RegReal src) (RegReal dst)
 
 makeMove delta vreg (InMem src) (InReg dst)
  = do	recordSpill (SpillJoinRM vreg)
- 	return	$ mkLoadInstr (RealReg dst) delta src
+ 	return	$ mkLoadInstr  (RegReal dst) delta src
 
 makeMove delta vreg (InReg src) (InMem dst)
  = do	recordSpill (SpillJoinRM vreg)
-	return	$ mkSpillInstr (RealReg src) delta dst
+	return	$ mkSpillInstr (RegReal src) delta dst
 
 -- we don't handle memory to memory moves.
 --	they shouldn't happen because we don't share stack slots between vregs.