Fix todo in compiler/nativeGen: Rename Size to Format
[ghc.git] / compiler / nativeGen / SPARC / CodeGen / CondCode.hs
1 module SPARC.CodeGen.CondCode (
2 getCondCode,
3 condIntCode,
4 condFltCode
5 )
6
7 where
8
9 import {-# SOURCE #-} SPARC.CodeGen.Gen32
10 import SPARC.CodeGen.Base
11 import SPARC.Instr
12 import SPARC.Regs
13 import SPARC.Cond
14 import SPARC.Imm
15 import SPARC.Base
16 import NCGMonad
17 import Format
18
19 import Cmm
20
21 import OrdList
22 import Outputable
23
24
25 getCondCode :: CmmExpr -> NatM CondCode
26 getCondCode (CmmMachOp mop [x, y])
27 =
28 case mop of
29 MO_F_Eq W32 -> condFltCode EQQ x y
30 MO_F_Ne W32 -> condFltCode NE x y
31 MO_F_Gt W32 -> condFltCode GTT x y
32 MO_F_Ge W32 -> condFltCode GE x y
33 MO_F_Lt W32 -> condFltCode LTT x y
34 MO_F_Le W32 -> condFltCode LE x y
35
36 MO_F_Eq W64 -> condFltCode EQQ x y
37 MO_F_Ne W64 -> condFltCode NE x y
38 MO_F_Gt W64 -> condFltCode GTT x y
39 MO_F_Ge W64 -> condFltCode GE x y
40 MO_F_Lt W64 -> condFltCode LTT x y
41 MO_F_Le W64 -> condFltCode LE x y
42
43 MO_Eq _ -> condIntCode EQQ x y
44 MO_Ne _ -> condIntCode NE x y
45
46 MO_S_Gt _ -> condIntCode GTT x y
47 MO_S_Ge _ -> condIntCode GE x y
48 MO_S_Lt _ -> condIntCode LTT x y
49 MO_S_Le _ -> condIntCode LE x y
50
51 MO_U_Gt _ -> condIntCode GU x y
52 MO_U_Ge _ -> condIntCode GEU x y
53 MO_U_Lt _ -> condIntCode LU x y
54 MO_U_Le _ -> condIntCode LEU x y
55
56 _ -> pprPanic "SPARC.CodeGen.CondCode.getCondCode" (ppr (CmmMachOp mop [x,y]))
57
58 getCondCode other = pprPanic "SPARC.CodeGen.CondCode.getCondCode" (ppr other)
59
60
61
62
63
64 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
65 -- passed back up the tree.
66
67 condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
68 condIntCode cond x (CmmLit (CmmInt y _))
69 | fits13Bits y
70 = do
71 (src1, code) <- getSomeReg x
72 let
73 src2 = ImmInt (fromInteger y)
74 code' = code `snocOL` SUB False True src1 (RIImm src2) g0
75 return (CondCode False cond code')
76
77 condIntCode cond x y = do
78 (src1, code1) <- getSomeReg x
79 (src2, code2) <- getSomeReg y
80 let
81 code__2 = code1 `appOL` code2 `snocOL`
82 SUB False True src1 (RIReg src2) g0
83 return (CondCode False cond code__2)
84
85
86 condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
87 condFltCode cond x y = do
88 dflags <- getDynFlags
89 (src1, code1) <- getSomeReg x
90 (src2, code2) <- getSomeReg y
91 tmp <- getNewRegNat FF64
92 let
93 promote x = FxTOy FF32 FF64 x tmp
94
95 pk1 = cmmExprType dflags x
96 pk2 = cmmExprType dflags y
97
98 code__2 =
99 if pk1 `cmmEqType` pk2 then
100 code1 `appOL` code2 `snocOL`
101 FCMP True (cmmTypeFormat pk1) src1 src2
102 else if typeWidth pk1 == W32 then
103 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
104 FCMP True FF64 tmp src2
105 else
106 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
107 FCMP True FF64 src1 tmp
108 return (CondCode True cond code__2)