Make the SPARC NCG compile again - it's still broken though.

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index f780636..af8408a 100644 (file)
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -306,10 +306,10 @@ assignMem_I64Code addrTree valueTree = do
          mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))
      return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
 
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do
+assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
      ChildCode64 vcode r_src_lo <- iselExpr64 valueTree    
      let 
-         r_dst_lo = mkVReg u_dst pk
+         r_dst_lo = mkVReg u_dst (cmmTypeSize pk)
          r_dst_hi = getHiVRegFromLo r_dst_lo
          r_src_hi = getHiVRegFromLo r_src_lo
          mov_lo = mkMOV r_src_lo r_dst_lo
@@ -336,10 +336,10 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
                          rlo
           )
 
-iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) isWord64 ty = do
-     r_dst_lo <-  getNewRegNat b32
+iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
+     r_dst_lo <-  getNewRegNat II32
      let r_dst_hi = getHiVRegFromLo r_dst_lo
-         r_src_lo = mkVReg uq b32
+         r_src_lo = mkVReg uq II32
          r_src_hi = getHiVRegFromLo r_src_lo
          mov_lo = mkMOV r_src_lo r_dst_lo
          mov_hi = mkMOV r_src_hi r_dst_hi
@@ -1429,10 +1429,10 @@ getRegister (CmmMachOp mop [x]) -- unary MachOps
 
       -- Conversions which are a nop on sparc
       MO_UU_Conv from to
-       | from == to    -> conversionNop to  x
-      MO_UU_Conv W32 W8 -> trivialCode I8 (AND False) x (CmmLit (CmmInt 255 I8))
-      MO_UU_Conv W32 to -> conversionNop to x
-      MO_SS_Conv W32 to -> conversionNop to x
+       | from == to    -> conversionNop (intSize to)  x
+      MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
+      MO_UU_Conv W32 to -> conversionNop (intSize to) x
+      MO_SS_Conv W32 to -> conversionNop (intSize to) x
 
       -- widenings
       MO_UU_Conv W8 W32  -> integerExtend False W8 W32  x
@@ -1526,8 +1526,8 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
     imulMayOflo rep a b = do
          (a_reg, a_code) <- getSomeReg a
         (b_reg, b_code) <- getSomeReg b
-        res_lo <- getNewRegNat b32
-        res_hi <- getNewRegNat b32
+        res_lo <- getNewRegNat II32
+        res_hi <- getNewRegNat II32
         let
            shift_amt  = case rep of
                          W32 -> 31
@@ -1545,8 +1545,8 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
 getRegister (CmmLoad mem pk) = do
     Amode src code <- getAmode mem
     let
-       code__2 dst = code `snocOL` LD pk src dst
-    return (Any pk code__2)
+       code__2 dst     = code `snocOL` LD (cmmTypeSize pk) src dst
+    return (Any (cmmTypeSize pk) code__2)
 
 getRegister (CmmLit (CmmInt i _))
   | fits13Bits i
@@ -1916,7 +1916,7 @@ getAmode (CmmMachOp (MO_Add rep) [x, y])
 -- XXX Is this same as "leaf" in Stix?
 getAmode (CmmLit lit)
   = do
-      tmp <- getNewRegNat b32
+      tmp <- getNewRegNat II32
       let
        code = unitOL (SETHI (HI imm__2) tmp)
       return (Amode (AddrRegImm tmp (LO imm__2)) code)
@@ -2306,9 +2306,9 @@ condFltCode cond x y = do
        pk2   = cmmExprType y
 
        code__2 =
-               if pk1 == pk2 then
+               if pk1 `cmmEqType` pk2 then
                    code1 `appOL` code2 `snocOL`
-                   FCMP True pk1 src1 src2
+                   FCMP True (cmmTypeSize pk1) src1 src2
                else if typeWidth pk1 == W32 then
                    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
                    FCMP True FF64 tmp src2
@@ -2570,9 +2570,10 @@ assignMem_FltCode pk addr src = do
     let
        pk__2   = cmmExprType src
        code__2 = code1 `appOL` code2 `appOL`
-           if   pk == pk__2 
+           if   sizeToWidth pk == typeWidth pk__2 
             then unitOL (ST pk src__2 dst__2)
-           else toOL [FxTOy pk__2 pk src__2 tmp1, ST pk tmp1 dst__2]
+           else toOL   [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
+                       , ST    pk tmp1 dst__2]
     return code__2
 
 -- Floating point assignment to a register/temporary
@@ -3503,10 +3504,10 @@ genCCall target dest_regs argsAndHints = do
         | otherwise
         = do
          (src, code) <- getSomeReg arg
-          tmp <- getNewRegNat (cmmExprType arg)
+          tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
           let
               pk   = cmmExprType arg
-          case pk of
+          case cmmTypeSize pk of
              FF64 -> do
                       v1 <- getNewRegNat II32
                       v2 <- getNewRegNat II32
@@ -3967,6 +3968,13 @@ genSwitch expr ids
                             BCTR [ id | Just id <- ids ]
                     ]
         return code
+#elif sparc_TARGET_ARCH
+genSwitch expr ids
+  | opt_PIC
+  = error "MachCodeGen: sparc genSwitch PIC not finished\n"
+  
+  | otherwise
+  = error "MachCodeGen: sparc genSwitch non-PIC not finished\n"
 #else
 #error "ToDo: genSwitch"
 #endif
@@ -4500,8 +4508,8 @@ trivialCode pk instr x y = do
 trivialFCode pk instr x y = do
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
-    tmp1 <- getNewRegNat (cmmExprType x)
-    tmp2 <- getNewRegNat (cmmExprType y)
+    tmp1 <- getNewRegNat (cmmTypeSize $ cmmExprType x)
+    tmp2 <- getNewRegNat (cmmTypeSize $ cmmExprType y)
     tmp <- getNewRegNat FF64
     let
        promote x = FxTOy FF32 FF64 x tmp
@@ -4510,7 +4518,7 @@ trivialFCode pk instr x y = do
        pk2   = cmmExprType y
 
        code__2 dst =
-               if pk1 == pk2 then
+               if pk1 `cmmEqType` pk2 then
                    code1 `appOL` code2 `snocOL`
                    instr (floatSize pk) src1 src2 dst
                else if typeWidth pk1 == W32 then
@@ -4519,7 +4527,8 @@ trivialFCode pk instr x y = do
                else
                    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
                    instr FF64 src1 tmp dst
-    return (Any (if pk1 == pk2 then pk1 else cmmFloat W64) code__2)
+    return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64) 
+               code__2)
 
 ------------
 trivialUCode size instr x = do
@@ -4733,17 +4742,20 @@ coerceFP2FP to x = do
 
 #if sparc_TARGET_ARCH
 
-coerceInt2FP pk1 pk2 x = do
+coerceInt2FP width1 width2 x = do
     (src, code) <- getSomeReg x
     let
        code__2 dst = code `appOL` toOL [
-           ST pk1 src (spRel (-2)),
-           LD pk1 (spRel (-2)) dst,
-           FxTOy pk1 pk2 dst dst]
-    return (Any pk2 code__2)
+           ST (intSize width1) src (spRel (-2)),
+           LD (intSize width1) (spRel (-2)) dst,
+           FxTOy (intSize width1) (floatSize width1) dst dst]
+    return (Any (floatSize $ width2) code__2)
 
 ------------
-coerceFP2Int pk fprep x = do
+coerceFP2Int width1 width2 x = do
+    let pk     = intSize width1
+        fprep  = floatSize width2
+
     (src, code) <- getSomeReg x
     reg <- getNewRegNat fprep
     tmp <- getNewRegNat pk

diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs
index 0c21f21..b4af046 100644 (file)
--- a/compiler/nativeGen/MachRegs.lhs
+++ b/compiler/nativeGen/MachRegs.lhs
@@ -74,7 +74,7 @@ module MachRegs (
        addrModeRegs, allFPArgRegs,
 #endif
 #if sparc_TARGET_ARCH
-       fits13Bits,
+       fits13Bits, 
        fpRel, gReg, iReg, lReg, oReg, largeOffsetError,
        fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
 #endif
@@ -194,14 +194,53 @@ data Size
 
 #if sparc_TARGET_ARCH /* || powerpc_TARGET_ARCH */
 data Size
-    = B     -- byte (signed)
-    | Bu    -- byte (unsigned)
-    | H     -- halfword (signed, 2 bytes)
-    | Hu    -- halfword (unsigned, 2 bytes)
-    | W            -- word (4 bytes)
-    | F            -- IEEE single-precision floating pt
-    | DF    -- IEEE single-precision floating pt
+    = II8     -- byte (signed)
+    | II8u    -- byte (unsigned)
+    | II16    -- halfword (signed, 2 bytes)
+    | II16u   -- halfword (unsigned, 2 bytes)
+    | II32    -- word (4 bytes)
+    | II64    -- word (8 bytes)
+    | FF32    -- IEEE single-precision floating pt
+    | FF64    -- IEEE single-precision floating pt
   deriving Eq
+
+
+intSize, floatSize :: Width -> Size
+intSize W8  = II8
+intSize W16 = II16u
+intSize W32 = II32
+intSize W64 = II64
+intSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+floatSize W32 = FF32
+floatSize W64 = FF64
+floatSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+wordSize :: Size
+wordSize = intSize wordWidth
+
+isFloatSize :: Size -> Bool
+isFloatSize FF32       = True
+isFloatSize FF64       = True
+isFloatSize _          = False
+
+cmmTypeSize :: CmmType -> Size
+cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty)
+              | otherwise      = intSize (typeWidth ty)
+
+sizeToWidth :: Size -> Width
+sizeToWidth size
+ = case size of
+       II8             -> W8
+       II8u            -> W8
+       II16            -> W16
+       II16u           -> W16
+       II32            -> W32
+       II64            -> W64
+       FF32            -> W32
+       FF64            -> W64
+
+
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -494,10 +533,11 @@ mkVReg u size
    = case size of
 #if sparc_TARGET_ARCH
         FF32    -> VirtualRegF u
+       FF64    -> VirtualRegD u
 #else
         FF32    -> VirtualRegD u
-#endif
         FF64    -> VirtualRegD u
+#endif
        _other -> panic "mkVReg"
 
 isVirtualReg :: Reg -> Bool
@@ -610,6 +650,10 @@ worst n classN classC
 #define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
 
+#elif sparc_TARGET_ARCH
+#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
+#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
+
 #else
 #error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE
 #endif

diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs
index 80702bd..0992f6e 100644 (file)
--- a/compiler/nativeGen/RegAllocInfo.hs
+++ b/compiler/nativeGen/RegAllocInfo.hs
@@ -768,15 +768,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 +821,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 +862,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 +887,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

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 2c41905..12f4cee 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -327,6 +327,13 @@ regDotColor reg
        RcFloat         -> text "red"
        RcDouble        -> text "green"
 
+#elif sparc_TARGET_ARCH
+regDotColor :: Reg -> SDoc
+regDotColor reg
+ = case regClass reg of
+       RcInteger       -> text "blue"
+       RcFloat         -> text "red"
+       RcDouble        -> text "green"
 #else
 #error ToDo: regDotColor
 #endif