NCG: fix mkRegRegMoveInstr for x86-64
[ghc-hetmet.git] / ghc / compiler / nativeGen / RegAllocInfo.hs
index 1987c28..98c4e2d 100644 (file)
@@ -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
-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]
@@ -215,6 +216,7 @@ regUsage instr = case instr of
 #endif    
 
     FETCHGOT reg        -> mkRU [] [reg]
+    FETCHPC  reg        -> mkRU [] [reg]
 
     COMMENT _          -> noUsage
     DELTA   _           -> noUsage
@@ -231,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]
@@ -261,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 */
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -298,7 +304,7 @@ regUsage instr = case instr of
     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   dst addr     -> usage (regAddr addr, [])
+    JMP   addr                 -> usage (regAddr addr, [])
 
     CALL  (Left imm)  n True  -> noUsage
     CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
@@ -307,8 +313,8 @@ regUsage instr = case instr of
 
     _                  -> noUsage
   where
-    usage (src, dst) = RU (regSetFromList (filter interesting src))
-                         (regSetFromList (filter interesting dst))
+    usage (src, dst) = RU (filter interesting src)
+                        (filter interesting dst)
 
     regAddr (AddrRegReg r1 r2) = [r1, r2]
     regAddr (AddrRegImm r1 _)  = [r1]
@@ -399,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
@@ -539,7 +557,8 @@ patchRegs instr env = case instr of
     CALL (Right reg) p -> CALL (Right (env reg)) p
     
     FETCHGOT reg        -> FETCHGOT (env reg)
-    
+    FETCHPC  reg        -> FETCHPC  (env reg)
+   
     NOP                        -> instr
     COMMENT _          -> instr
     DELTA _            -> instr
@@ -599,7 +618,7 @@ 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   dsts addr     -> JMP dsts (fixAddr addr)
+    JMP   addr          -> JMP (fixAddr addr)
     CALL  (Left i) n t  -> CALL (Left i) n t
     CALL  (Right r) n t -> CALL (Right (env r)) n t
     _ -> instr
@@ -722,11 +741,11 @@ mkSpillInstr reg delta slot
 #ifdef sparc_TARGET_ARCH
        {-SPARC: spill below frame pointer leaving 2 words/spill-}
                         let{off_w = 1 + (off `div` 4);
-                            sz = case regClass vreg of {
-                                    RcInteger -> W;
-                                    RcFloat   -> F;
-                                    RcDouble  -> DF}}
-                        in ST sz dyn (fpRel (- off_w))
+                            sz = case regClass reg of {
+                                    RcInteger -> I32;
+                                   RcFloat   -> F32;
+                                    RcDouble  -> F64}}
+                        in ST sz reg (fpRel (- off_w))
 #endif
 #ifdef powerpc_TARGET_ARCH
     let sz = case regClass reg of
@@ -763,11 +782,11 @@ mkLoadInstr reg delta slot
 #endif
 #if sparc_TARGET_ARCH
         let{off_w = 1 + (off `div` 4);
-            sz = case regClass vreg of {
-                   RcInteger -> W;
-                   RcFloat   -> F;
-                   RcDouble  -> DF}}
-        in LD sz (fpRel (- off_w)) dyn
+            sz = case regClass reg of {
+                   RcInteger -> I32;
+                  RcFloat   -> F32;
+                   RcDouble  -> F64}}
+        in LD sz (fpRel (- off_w)) reg
 #endif
 #if powerpc_TARGET_ARCH
     let sz = case regClass reg of
@@ -776,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)