NCG: Move the graph allocator into its own dir
[ghc-hetmet.git] / compiler / nativeGen / RegAllocInfo.hs
index 80702bd..57c9ce6 100644 (file)
@@ -21,6 +21,7 @@ module RegAllocInfo (
        regUsage,
        patchRegs,
        jumpDests,
+       isJumpish,
        patchJump,
        isRegRegMove,
 
@@ -295,7 +296,10 @@ regUsage instr = case instr of
     SUB   x cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
     UMUL    cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
     SMUL    cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
+    UDIV    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
+    SDIV    cc r1 ar r2 -> usage (r1 : regRI ar, [r2])
     RDY   rd            -> usage ([], [rd])
+    WRY   r1 r2         -> usage ([r1, r2], [])
     AND   b r1 ar r2   -> usage (r1 : regRI ar, [r2])
     ANDN  b r1 ar r2   -> usage (r1 : regRI ar, [r2])
     OR    b r1 ar r2           -> usage (r1 : regRI ar, [r2])
@@ -317,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)
@@ -421,11 +425,51 @@ jumpDests insn acc
         BCC _ id        -> id : acc
         BCCFAR _ id     -> id : acc
         BCTR targets    -> targets ++ 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
@@ -435,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
 
@@ -664,7 +716,10 @@ patchRegs instr env = case instr of
     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
     UMUL    cc r1 ar r2        -> UMUL cc (env r1) (fixRI ar) (env r2)
     SMUL    cc r1 ar r2        -> SMUL cc (env r1) (fixRI ar) (env r2)
+    UDIV    cc r1 ar r2        -> UDIV cc (env r1) (fixRI ar) (env r2)
+    SDIV    cc r1 ar r2        -> SDIV cc (env r1) (fixRI ar) (env r2)
     RDY   rd            -> RDY (env rd)
+    WRY   r1 r2                -> WRY (env r1) (env r2)
     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
@@ -685,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
@@ -768,15 +826,25 @@ patchRegs instr env = case instr of
 -- by assigning the src and dest temporaries to the same real register.
 
 isRegRegMove :: Instr -> Maybe (Reg,Reg)
+
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 -- TMP:
 isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
+
 #elif powerpc_TARGET_ARCH
 isRegRegMove (MR dst src) = Just (src,dst)
-#else
-#error ToDo: isRegRegMove
+
+#elif sparc_TARGET_ARCH
+isRegRegMove instr
+ = case instr of
+       ADD False False src (RIReg src2) dst
+        | g0 == src2           -> Just (src, dst)
+
+       FMOV FF64 src dst       -> Just (src, dst)
+       FMOV FF32  src dst      -> Just (src, dst)
+       _                       -> Nothing
 #endif
-isRegRegMove _ = Nothing
+isRegRegMove _  = Nothing
 
 -- -----------------------------------------------------------------------------
 -- Generating spill instructions
@@ -811,9 +879,9 @@ mkSpillInstr reg delta slot
        {-SPARC: spill below frame pointer leaving 2 words/spill-}
                         let{off_w = 1 + (off `div` 4);
                             sz = case regClass reg of {
-                                    RcInteger -> I32;
-                                   RcFloat   -> F32;
-                                    RcDouble  -> F64}}
+                                    RcInteger -> II32;
+                                   RcFloat   -> FF32;
+                                    RcDouble  -> FF64;}}
                         in ST sz reg (fpRel (negate off_w))
 #endif
 #ifdef powerpc_TARGET_ARCH
@@ -852,7 +920,7 @@ mkLoadInstr reg delta slot
             sz = case regClass reg of {
                    RcInteger -> II32;
                   RcFloat   -> FF32;
-                   RcDouble  -> F64}}
+                   RcDouble  -> FF64}}
         in LD sz (fpRel (- off_w)) reg
 #endif
 #if powerpc_TARGET_ARCH
@@ -877,6 +945,11 @@ mkRegRegMoveInstr src dst
 #endif
 #elif powerpc_TARGET_ARCH
     = MR dst src
+#elif sparc_TARGET_ARCH
+    = case regClass src of
+       RcInteger -> ADD  False False src (RIReg g0) dst
+       RcDouble  -> FMOV FF64 src dst
+       RcFloat   -> FMOV FF32  src dst
 #else
 #error ToDo: mkRegRegMoveInstr
 #endif
@@ -893,7 +966,7 @@ mkBranchInstr id = [JXX ALWAYS id]
 #endif
 
 #if sparc_TARGET_ARCH
-mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP]
+mkBranchInstr id = [BI ALWAYS False id, NOP]
 #endif
 
 #if powerpc_TARGET_ARCH