X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.hs;h=98c4e2dfe061310d19ec1cfc1481f1c1e819e5c7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=1a5de431c25b7031494004368934a0378d83674c;hpb=a28ce0541a45600b18dfe5e47e28870a81dd497b;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs
index 1a5de43..98c4e2d 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.hs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.hs
@@ -14,19 +14,20 @@ module RegAllocInfo (
 	regUsage,
 	patchRegs,
 	jumpDests,
+	patchJump,
 	isRegRegMove,
 
 	maxSpillSlots,
 	mkSpillInstr,
 	mkLoadInstr,
+	mkRegRegMoveInstr,
+	mkBranchInstr
     ) where
 
 #include "HsVersions.h"
 
 import Cmm		( BlockId )
-#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
-import MachOp           ( MachRep(..) )
-#endif
+import MachOp           ( MachRep(..), wordRep )
 import MachInstrs
 import MachRegs
 import Outputable
@@ -161,16 +162,16 @@ regUsage instr = case instr of
     SHL    sz imm dst	-> usageRM imm dst
     SAR    sz imm dst	-> usageRM imm dst
     SHR    sz imm dst	-> usageRM imm dst
-    BT     sz imm src	-> mkRU (use_R src) []
+    BT     sz imm src	-> mkRUR (use_R src)
 
-    PUSH   sz op	-> mkRU (use_R op) []
+    PUSH   sz op	-> mkRUR (use_R op)
     POP    sz op	-> mkRU [] (def_W op)
-    TEST   sz src dst	-> mkRU (use_R src ++ use_R dst) []
-    CMP    sz src dst	-> mkRU (use_R src ++ use_R dst) []
+    TEST   sz src dst	-> mkRUR (use_R src ++ use_R dst)
+    CMP    sz src dst	-> mkRUR (use_R src ++ use_R dst)
     SETCC  cond op	-> mkRU [] (def_W op)
     JXX    cond lbl	-> mkRU [] []
-    JMP    op		-> mkRU (use_R op) []
-    JMP_TBL op ids      -> mkRU (use_R op) []
+    JMP    op		-> mkRUR (use_R op)
+    JMP_TBL op ids      -> mkRUR (use_R op)
     CALL (Left imm)  params -> mkRU params callClobberedRegs
     CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
     CLTD   sz		-> mkRU [eax] [edx]
@@ -179,7 +180,7 @@ regUsage instr = case instr of
 #if i386_TARGET_ARCH
     GMOV   src dst	-> mkRU [src] [dst]
     GLD    sz src dst	-> mkRU (use_EA src) [dst]
-    GST    sz src dst	-> mkRU (src : use_EA dst) []
+    GST    sz src dst	-> mkRUR (src : use_EA dst)
 
     GLDZ   dst		-> mkRU [] [dst]
     GLD1   dst		-> mkRU [] [dst]
@@ -195,7 +196,7 @@ regUsage instr = case instr of
     GMUL   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
     GDIV   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
 
-    GCMP   sz src1 src2	-> mkRU [src1,src2] []
+    GCMP   sz src1 src2	-> mkRUR [src1,src2]
     GABS   sz src dst	-> mkRU [src] [dst]
     GNEG   sz src dst	-> mkRU [src] [dst]
     GSQRT  sz src dst	-> mkRU [src] [dst]
@@ -232,17 +233,17 @@ regUsage instr = case instr of
     -- 2 operand form; first operand Read; second Written
     usageRW :: Operand -> Operand -> RegUsage
     usageRW op (OpReg reg) = mkRU (use_R op) [reg]
-    usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
+    usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
 
     -- 2 operand form; first operand Read; second Modified
     usageRM :: Operand -> Operand -> RegUsage
     usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
-    usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) []
+    usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
 
     -- 1 operand form; operand Modified
     usageM :: Operand -> RegUsage
     usageM (OpReg reg)    = mkRU [reg] [reg]
-    usageM (OpAddr ea)    = mkRU (use_EA ea) []
+    usageM (OpAddr ea)    = mkRUR (use_EA ea)
 
     -- Registers defd when an operand is written.
     def_W (OpReg reg)  = [reg]
@@ -262,8 +263,12 @@ regUsage instr = case instr of
 	      use_index EAIndexNone   = []
 	      use_index (EAIndex i _) = [i]
 
-    mkRU src dst = RU (filter interesting src)
-  	    	      (filter interesting dst)
+    mkRUR src = src' `seq` RU src' []
+	where src' = filter interesting src
+
+    mkRU src dst = src' `seq` dst' `seq` RU src' dst'
+	where src' = filter interesting src
+	      dst' = filter interesting dst
 
 #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -400,6 +405,18 @@ jumpDests insn acc
 #endif
 	_other		-> acc
 
+patchJump :: Instr -> BlockId -> BlockId -> Instr
+
+patchJump insn old new
+  = case insn of
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+	JXX cc id | id == old -> JXX cc new
+	JMP_TBL op ids -> error "Cannot patch JMP_TBL"
+#elif powerpc_TARGET_ARCH
+        BCC cc id | id == old -> BCC cc new
+        BCTR targets -> error "Cannot patch BCTR"
+#endif
+	_other		-> insn
 
 -- -----------------------------------------------------------------------------
 -- 'patchRegs' function
@@ -778,6 +795,42 @@ mkLoadInstr reg delta slot
     in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
 #endif
 
+mkRegRegMoveInstr
+    :: Reg
+    -> Reg
+    -> Instr
+mkRegRegMoveInstr src dst
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+    = case regClass src of
+        RcInteger -> MOV wordRep (OpReg src) (OpReg dst)
+#if i386_TARGET_ARCH
+        RcDouble  -> GMOV src dst
+#else
+        RcDouble  -> MOV F64 (OpReg src) (OpReg dst)
+#endif
+#elif powerpc_TARGET_ARCH
+    = MR dst src
+#endif
+
+mkBranchInstr
+    :: BlockId
+    -> [Instr]
+#if alpha_TARGET_ARCH
+mkBranchInstr id = [BR id]
+#endif
+
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+mkBranchInstr id = [JXX ALWAYS id]
+#endif
+
+#if sparc_TARGET_ARCH
+mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP]
+#endif
+
+#if powerpc_TARGET_ARCH
+mkBranchInstr id = [BCC ALWAYS id]
+#endif
+
 
 spillSlotSize :: Int
 spillSlotSize = IF_ARCH_i386(12, 8)