X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=4f85a084eddd94c1eacc6b6fc7f3e91e45cfccbd;hb=a12e845684c10955bc594cdb20d1f13fae14873d;hp=deb5f34e2108809872171b8c97575c7eff5a2773;hpb=0df5099f0c2088e2ccbb5b8974a7eae4d77eaa1c;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs
index deb5f34..4f85a08 100644
--- a/compiler/nativeGen/RegAllocInfo.hs
+++ b/compiler/nativeGen/RegAllocInfo.hs
@@ -21,6 +21,7 @@ module RegAllocInfo (
 	regUsage,
 	patchRegs,
 	jumpDests,
+	isJumpish,
 	patchJump,
 	isRegRegMove,
 
@@ -38,8 +39,8 @@ module RegAllocInfo (
 import BlockId
 import Cmm
 import CLabel
-import MachInstrs
-import MachRegs
+import Instrs
+import Regs
 import Outputable
 import Constants	( rESERVED_C_STACK_BYTES )
 import FastBool
@@ -320,8 +321,8 @@ regUsage instr = case instr of
     FSUB  s r1 r2 r3 	-> usage ([r1, r2], [r3])
     FxTOy s1 s2 r1 r2 	-> usage ([r1], [r2])
 
-    -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
-    JMP   addr 	        -> usage (regAddr addr, [])
+    JMP     addr 	-> usage (regAddr addr, [])
+    JMP_TBL addr ids    -> usage (regAddr addr, [])
 
     CALL  (Left imm)  n True  -> noUsage
     CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
@@ -427,13 +428,48 @@ jumpDests insn acc
 #elif sparc_TARGET_ARCH
 	BI   _ _ id	-> id : acc
 	BF   _ _ id	-> id : acc
+	JMP_TBL _ ids	-> ids ++ acc
 #else
 #error "RegAllocInfo.jumpDests not finished"
 #endif
 	_other		-> acc
 
-patchJump :: Instr -> BlockId -> BlockId -> Instr
 
+-- | Check whether a particular instruction is a jump, branch or call instruction (jumpish)
+--	We can't just use jumpDests above because the jump might take its arg,
+--	so the instr won't contain a blockid.
+--
+isJumpish :: Instr -> Bool
+isJumpish instr
+ = case instr of
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+	JMP{}		-> True
+	JXX{}		-> True
+	JXX_GBL{}	-> True
+	JMP_TBL{}	-> True
+	CALL{}		-> True
+
+#elif powerpc_TARGET_ARCH
+	BCC{}		-> True
+	BCCFAR{}	-> True
+	JMP{}		-> True
+	
+#elif sparc_TARGET_ARCH
+	BI{}		-> True
+	BF{}		-> True
+	JMP{}		-> True
+	JMP_TBL{}	-> True
+	CALL{}		-> True
+#else
+#error	"RegAllocInfo.isJumpish: not implemented for this architecture"
+#endif
+	_		-> False
+	
+
+-- | Change the destination of this jump instruction
+--	Used in joinToTargets in the linear allocator, when emitting fixup code
+--	for join points.
+patchJump :: Instr -> BlockId -> BlockId -> Instr
 patchJump insn old new
   = case insn of
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
@@ -443,6 +479,14 @@ patchJump insn old new
         BCC cc id | id == old -> BCC cc new
         BCCFAR cc id | id == old -> BCCFAR cc new
         BCTR targets -> error "Cannot patch BCTR"
+#elif sparc_TARGET_ARCH
+	BI cc annul id
+	 | id == old	-> BI cc annul new
+	 
+	BF cc annul id
+	 | id == old	-> BF cc annul new
+#else
+#error	"RegAllocInfo.patchJump not finished"
 #endif
 	_other		-> insn
 
@@ -696,7 +740,10 @@ patchRegs instr env = case instr of
     FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
-    JMP   addr          -> JMP (fixAddr addr)
+
+    JMP     addr        -> JMP     (fixAddr addr)
+    JMP_TBL addr ids    -> JMP_TBL (fixAddr addr) ids
+
     CALL  (Left i) n t  -> CALL (Left i) n t
     CALL  (Right r) n t -> CALL (Right (env r)) n t
     _ -> instr