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

diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index d3f821b..7d2cbcd 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -19,13 +19,11 @@ import RegAlloc.Linear.State
 import RegAlloc.Linear.Base
 import RegAlloc.Linear.FreeRegs
 import RegAlloc.Liveness
+import Instruction
+import Reg
 
 import BlockId
-import Instrs
-import Regs
-import RegAllocInfo
 import Cmm	hiding (RegSet)
-
 import Digraph
 import Outputable
 import Unique
@@ -37,39 +35,41 @@ import UniqSet
 --	vregs are in the correct regs for its destination.
 --
 joinToTargets
-	:: BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
+	:: Instruction instr
+	=> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
 					--	that are known to be live on the entry to each block.
 
 	-> BlockId			-- ^ id of the current block
-	-> Instr			-- ^ branch instr on the end of the source block.
+	-> instr			-- ^ branch instr on the end of the source block.
 
-	-> RegM ([NatBasicBlock]	--   fresh blocks of fixup code.
-		, Instr)		--   the original branch instruction, but maybe patched to jump
+	-> RegM ([NatBasicBlock instr]	--   fresh blocks of fixup code.
+		, instr)		--   the original branch instruction, but maybe patched to jump
 					--	to a fixup block first.
 
 joinToTargets block_live id instr
 
 	-- we only need to worry about jump instructions.
-	| not $ isJumpish instr
+	| not $ isJumpishInstr instr
 	= return ([], instr)
 
 	| otherwise
-	= joinToTargets' block_live [] id instr (jumpDests instr [])
+	= joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
 
 -----
 joinToTargets'
-	:: BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
+	:: Instruction instr
+	=> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
 					--	that are known to be live on the entry to each block.
 
-	-> [NatBasicBlock]		-- ^ acc blocks of fixup code.
+	-> [NatBasicBlock instr]	-- ^ acc blocks of fixup code.
 
 	-> BlockId			-- ^ id of the current block
-	-> Instr			-- ^ branch instr on the end of the source block.
+	-> instr			-- ^ branch instr on the end of the source block.
 
 	-> [BlockId]			-- ^ branch destinations still to consider.
 
-	-> RegM ( [NatBasicBlock]
-		, Instr)
+	-> RegM ( [NatBasicBlock instr]
+		, instr)
 
 -- no more targets to consider. all done.
 joinToTargets' _          new_blocks _ instr []
@@ -173,7 +173,7 @@ joinToTargets_again
 		--	then that will jump to our original destination.
 		fixup_block_id <- getUniqueR
 		let block = BasicBlock (BlockId fixup_block_id) 
-				$ fixUpInstrs ++ mkBranchInstr dest
+				$ fixUpInstrs ++ mkJumpInstr dest
 		
 {-		pprTrace
 			("joinToTargets: fixup code is:")
@@ -187,7 +187,11 @@ joinToTargets_again
 
 		 -- patch the original branch instruction so it goes to our
 		 --	fixup block instead.
-		 _	-> let	instr'	=  patchJump instr dest (BlockId fixup_block_id)
+		 _	-> let	instr'	=  patchJumpInstr instr 
+		 				(\bid -> if bid == dest 
+								then BlockId fixup_block_id 
+								else dest)
+						
 		 	   in	joinToTargets' block_live (block : new_blocks) block_id instr' dests
 
 
@@ -256,7 +260,9 @@ expandNode vreg src dst
 --	destinations. We have eliminated any possibility of single-node
 --	cycles in expandNode above.
 --
-handleComponent :: Int -> Instr -> SCC (Unique, Loc, [Loc]) -> RegM [Instr]
+handleComponent 
+	:: Instruction instr
+	=> Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM [instr]
 
 -- If the graph is acyclic then we won't get the swapping problem below.
 --	In this case we can just do the moves directly, and avoid having to
@@ -305,11 +311,12 @@ handleComponent _ _ (CyclicSCC _)
 -- | Move a vreg between these two locations.
 --
 makeMove 
-	:: Int 		-- ^ current C stack delta.
+	:: Instruction instr
+	=> Int 		-- ^ current C stack delta.
 	-> Unique 	-- ^ unique of the vreg that we're moving.
 	-> Loc 		-- ^ source location.
 	-> Loc 		-- ^ destination location.
-	-> RegM Instr	-- ^ move instruction.
+	-> RegM instr	-- ^ move instruction.
 
 makeMove _     vreg (InReg src) (InReg dst)
  = do	recordSpill (SpillJoinRR vreg)