import Size
import Reg
-import Cmm
-import BlockId
+import OldCmm
+import Control.Monad (liftM)
import OrdList
import Outputable
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
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
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)
return (Any II32 code__2)
condIntReg cond x y = do
- bid1@(BlockId _) <- getBlockIdNat
- bid2@(BlockId _) <- getBlockIdNat
+ bid1 <- liftM (\a -> seq a a) getBlockIdNat
+ bid2 <- liftM (\a -> seq a a) 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)
condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg cond x y = do
- bid1@(BlockId _) <- getBlockIdNat
- bid2@(BlockId _) <- getBlockIdNat
+ bid1 <- liftM (\a -> seq a a) getBlockIdNat
+ bid2 <- liftM (\a -> seq a a) getBlockIdNat
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)
+
+
+
+