SPARC NCG: Add jumps to end of blocks when working out condition codes
[ghc-hetmet.git] / compiler / nativeGen / SPARC / CodeGen / Gen32.hs
index 9a623d9..4ae87df 100644 (file)
@@ -104,40 +104,81 @@ getRegister (CmmLit (CmmFloat d W64)) = do
            LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] 
     return (Any FF64 code)
 
-getRegister (CmmMachOp mop [x]) -- unary MachOps
+
+-- Unary machine ops
+getRegister (CmmMachOp mop [x])
   = case mop of
-      MO_F_Neg W32     -> trivialUFCode FF32 (FNEG FF32) x
-      MO_F_Neg W64     -> trivialUFCode FF64 (FNEG FF64) x
+       -- Floating point negation -------------------------
+       MO_F_Neg W32            -> trivialUFCode FF32 (FNEG FF32) x
+       MO_F_Neg W64            -> trivialUFCode FF64 (FNEG FF64) x
+
+
+       -- Integer negation --------------------------------
+       MO_S_Neg rep            -> trivialUCode (intSize rep) (SUB False False g0) x
+       MO_Not rep              -> trivialUCode (intSize rep) (XNOR False g0) x
+
+
+       -- Float word size conversion ----------------------
+       MO_FF_Conv W64 W32      -> coerceDbl2Flt x
+       MO_FF_Conv W32 W64      -> coerceFlt2Dbl x
+
+
+       -- Float <-> Signed Int conversion -----------------
+       MO_FS_Conv from to      -> coerceFP2Int from to x
+       MO_SF_Conv from to      -> coerceInt2FP from to x
 
-      MO_S_Neg rep     -> trivialUCode (intSize rep) (SUB False False g0) x
-      MO_Not rep       -> trivialUCode (intSize rep) (XNOR False g0) x
 
-      MO_FF_Conv W64 W32-> coerceDbl2Flt x
-      MO_FF_Conv W32 W64-> coerceFlt2Dbl x
+       -- Unsigned integer word size conversions ----------
 
-      MO_FS_Conv from to -> coerceFP2Int from to x
-      MO_SF_Conv from to -> coerceInt2FP from to x
+       -- If it's the same size, then nothing needs to be done.
+       MO_UU_Conv from to
+        | from == to           -> conversionNop (intSize to)  x
 
-      -- Conversions which are a nop on sparc
-      MO_UU_Conv from to
-       | 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
+       -- To narrow an unsigned word, mask out the high bits to simulate what would 
+       --      happen if we copied the value into a smaller register.
+       MO_UU_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+       MO_UU_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+
+       -- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
+       --      case because the only way we can load it is via SETHI, which needs 2 ops.
+       --      Do some shifts to chop out the high bits instead.
+       MO_UU_Conv W32 W16      
+        -> do  tmpReg          <- getNewRegNat II32
+               (xReg, xCode)   <- getSomeReg x
+               let code dst
+                       =       xCode
+                       `appOL` toOL
+                               [ SLL xReg   (RIImm $ ImmInt 16) tmpReg
+                               , SRL tmpReg (RIImm $ ImmInt 16) dst]
+                               
+               return  $ Any II32 code
+                       
+               --       trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
+
+       -- To widen an unsigned word we don't have to do anything.
+       --      Just leave it in the same register and mark the result as the new size.
+       MO_UU_Conv W8  W16      -> conversionNop (intSize W16)  x
+       MO_UU_Conv W8  W32      -> conversionNop (intSize W32)  x
+       MO_UU_Conv W16 W32      -> conversionNop (intSize W32)  x
 
-      MO_UU_Conv W8  to@W32  -> conversionNop (intSize to)  x
-      MO_UU_Conv W16 to@W32  -> conversionNop (intSize to)  x
-      MO_UU_Conv W8  to@W16  -> conversionNop (intSize to)  x
 
-      -- sign extension
-      MO_SS_Conv W8  W32  -> integerExtend W8  W32 x
-      MO_SS_Conv W16 W32  -> integerExtend W16 W32 x
-      MO_SS_Conv W8  W16  -> integerExtend W8  W16 x
+       -- Signed integer word size conversions ------------
 
-      _                  -> panic ("Unknown unary mach op: " ++ show mop)
+       -- Mask out high bits when narrowing them
+       MO_SS_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+       MO_SS_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+       MO_SS_Conv W32 W16      -> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
 
+       -- Sign extend signed words when widening them.
+       MO_SS_Conv W8  W16      -> integerExtend W8  W16 x
+       MO_SS_Conv W8  W32      -> integerExtend W8  W32 x
+       MO_SS_Conv W16 W32      -> integerExtend W16 W32 x
 
-getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
+       _                       -> panic ("Unknown unary mach op: " ++ show mop)
+
+
+-- Binary machine ops
+getRegister (CmmMachOp mop [x, y]) 
   = case mop of
       MO_Eq _          -> condIntReg EQQ x y
       MO_Ne _          -> condIntReg NE x y
@@ -147,10 +188,10 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
       MO_S_Lt _                -> condIntReg LTT x y
       MO_S_Le _                -> condIntReg LE x y
              
-      MO_U_Gt W32      -> condIntReg GTT x y
-      MO_U_Ge W32      -> condIntReg GE x y
-      MO_U_Lt W32      -> condIntReg LTT x y
-      MO_U_Le W32      -> condIntReg LE x y
+      MO_U_Gt W32      -> condIntReg GU  x y
+      MO_U_Ge W32      -> condIntReg GEU x y
+      MO_U_Lt W32      -> condIntReg LU  x y
+      MO_U_Le W32      -> condIntReg LEU x y
 
       MO_U_Gt W16      -> condIntReg GU  x y
       MO_U_Ge W16      -> condIntReg GEU x y
@@ -250,8 +291,12 @@ integerExtend from to expr
        return (Any (intSize to) code)
                                
 
+-- | For nop word format conversions we set the resulting value to have the
+--     required size, but don't need to generate any actual code.
+--
 conversionNop
        :: Size -> CmmExpr -> NatM Register
+
 conversionNop new_rep expr
  = do  e_code <- getRegister expr
        return (setSizeOfRegister e_code new_rep)
@@ -597,13 +642,23 @@ condIntReg cond x y = do
     bid2@(BlockId _) <- getBlockIdNat
     CondCode _ cond cond_code <- condIntCode cond x y
     let
-       code__2 dst = cond_code `appOL` toOL [
-           BI cond False bid1, NOP,
-           OR False g0 (RIImm (ImmInt 0)) dst,
-           BI ALWAYS False bid2, NOP,
-           NEWBLOCK bid1,
-           OR False g0 (RIImm (ImmInt 1)) dst,
-           NEWBLOCK bid2]
+       code__2 dst 
+        =      cond_code 
+         `appOL` toOL 
+               [ BI cond False bid1
+               , NOP
+
+               , OR False g0 (RIImm (ImmInt 0)) dst
+               , BI ALWAYS False bid2
+               , NOP
+
+               , NEWBLOCK bid1
+               , OR False g0 (RIImm (ImmInt 1)) dst
+               , BI ALWAYS False bid2
+               , NOP
+
+               , NEWBLOCK bid2]
+
     return (Any II32 code__2)
 
 
@@ -614,12 +669,26 @@ condFltReg cond x y = do
 
     CondCode _ cond cond_code <- condFltCode cond x y
     let
-       code__2 dst = cond_code `appOL` toOL [ 
-           NOP,
-           BF cond False bid1, NOP,
-           OR False g0 (RIImm (ImmInt 0)) dst,
-           BI ALWAYS False bid2, NOP,
-           NEWBLOCK bid1,
-           OR False g0 (RIImm (ImmInt 1)) dst,
-           NEWBLOCK bid2]
+       code__2 dst 
+        =      cond_code 
+         `appOL` toOL 
+               [ NOP
+               , BF cond False bid1
+               , NOP
+
+               , OR False g0 (RIImm (ImmInt 0)) dst
+               , BI ALWAYS False bid2
+               , NOP
+
+               , NEWBLOCK bid1
+               , OR False g0 (RIImm (ImmInt 1)) dst
+               , BI ALWAYS False bid2
+               , NOP
+
+               , NEWBLOCK bid2 ]
+
     return (Any II32 code__2)
+
+
+
+