# Changeset View

Changeset View

# Standalone View

Standalone View

# compiler/codeGen/StgCmmPrim.hs

Show First 20 Lines • Show All 840 Lines • ▼ Show 20 Line(s) | 840 | IntSubCOp | (ncg && x86ish) | |||
---|---|---|---|---|---|

841 | || llvm -> Left (MO_SubIntC (wordWidth dflags)) | 841 | || llvm -> Left (MO_SubIntC (wordWidth dflags)) | ||

842 | | otherwise -> Right genericIntSubCOp | 842 | | otherwise -> Right genericIntSubCOp | ||

843 | 843 | | |||

844 | WordMul2Op | ncg && x86ish | 844 | WordMul2Op | ncg && x86ish | ||

845 | || llvm -> Left (MO_U_Mul2 (wordWidth dflags)) | 845 | || llvm -> Left (MO_U_Mul2 (wordWidth dflags)) | ||

846 | | otherwise -> Right genericWordMul2Op | 846 | | otherwise -> Right genericWordMul2Op | ||

847 | FloatFabsOp | (ncg && x86ish) | 847 | FloatFabsOp | (ncg && x86ish) | ||

848 | || llvm -> Left MO_F32_Fabs | 848 | || llvm -> Left MO_F32_Fabs | ||

849 | | otherwise -> Right genericFloatFabsOp | 849 | | otherwise -> Right $ genericFabsOp W32 | ||

850 | DoubleFabsOp | (ncg && x86ish) | 850 | DoubleFabsOp | (ncg && x86ish) | ||

851 | || llvm -> Left MO_F64_Fabs | 851 | || llvm -> Left MO_F64_Fabs | ||

852 | | otherwise -> Right genericDoubleFabsOp | 852 | | otherwise -> Right $ genericFabsOp W64 | ||

853 | 853 | | |||

854 | _ -> pprPanic "emitPrimOp: can't translate PrimOp " (ppr op) | 854 | _ -> pprPanic "emitPrimOp: can't translate PrimOp " (ppr op) | ||

855 | where | 855 | where | ||

856 | ncg = case hscTarget dflags of | 856 | ncg = case hscTarget dflags of | ||

857 | HscAsm -> True | 857 | HscAsm -> True | ||

858 | _ -> False | 858 | _ -> False | ||

859 | llvm = case hscTarget dflags of | 859 | llvm = case hscTarget dflags of | ||

860 | HscLlvm -> True | 860 | HscLlvm -> True | ||

▲ Show 20 Lines • Show All 204 Lines • ▼ Show 20 Line(s) | 1064 | (or (bottomHalf (CmmReg xlyl)) | |||

1065 | (toTopHalf (CmmReg r))), | 1065 | (toTopHalf (CmmReg r))), | ||

1066 | mkAssign (CmmLocal res_h) | 1066 | mkAssign (CmmLocal res_h) | ||

1067 | (sum [mul (topHalf arg_x) (topHalf arg_y), | 1067 | (sum [mul (topHalf arg_x) (topHalf arg_y), | ||

1068 | topHalf (CmmReg xhyl), | 1068 | topHalf (CmmReg xhyl), | ||

1069 | topHalf (CmmReg xlyh), | 1069 | topHalf (CmmReg xlyh), | ||

1070 | topHalf (CmmReg r)])] | 1070 | topHalf (CmmReg r)])] | ||

1071 | genericWordMul2Op _ _ = panic "genericWordMul2Op" | 1071 | genericWordMul2Op _ _ = panic "genericWordMul2Op" | ||

1072 | 1072 | | |||

1073 | genericFloatFabsOp :: GenericOp | 1073 | -- This replicates what we had in libraries/base/GHC/Float.hs: | ||

1074 | genericFloatFabsOp [res_r, res_c] [aa, bb] | 1074 | -- | ||

1075 | -- abs x | x == 0 = 0 -- handles (-0.0) | ||||

1076 | -- | x > 0 = x | ||||

1077 | -- | otherwise = negateFloat x | ||||

1078 | genericFabsOp :: Width -> GenericOp | ||||

1079 | genericFabsOp w [res_r] [aa] | ||||

1075 | = do dflags <- getDynFlags | 1080 | = do dflags <- getDynFlags | ||

1076 | emit $ catAGraphs [ | 1081 | let zero = CmmLit (CmmFloat 0 w) | ||

1077 | mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]), | | |||

1078 | mkAssign (CmmLocal res_c) $ | | |||

1079 | CmmMachOp (mo_wordUShr dflags) [ | | |||

1080 | CmmMachOp (mo_wordAnd dflags) [ | | |||

1081 | CmmMachOp (mo_wordXor dflags) [aa,bb], | | |||

1082 | CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] | | |||

1083 | ], | | |||

1084 | mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) | | |||

1085 | ] | | |||

1086 | ] | | |||

1087 | genericFloatFabsOp _ _ = panic "genericFloatFabsOp" | | |||

1088 | 1082 | | |||

1089 | genericDoubleFabsOp :: GenericOp | 1083 | eq x y = CmmMachOp (MO_F_Eq w) [x, y] | ||

1090 | genericDoubleFabsOp [res_r, res_c] [aa, bb] | 1084 | gt x y = CmmMachOp (MO_F_Gt w) [x, y] | ||

1091 | = do dflags <- getDynFlags | 1085 | | ||

1092 | emit $ catAGraphs [ | 1086 | neg x = CmmMachOp (MO_F_Neg w) [x] | ||

1093 | mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]), | 1087 | | ||

1094 | mkAssign (CmmLocal res_c) $ | 1088 | g1 = catAGraphs [mkAssign (CmmLocal res_r) zero] | ||

1095 | CmmMachOp (mo_wordUShr dflags) [ | 1089 | g2 = catAGraphs [mkAssign (CmmLocal res_r) aa] | ||

1096 | CmmMachOp (mo_wordAnd dflags) [ | 1090 | | ||

1097 | CmmMachOp (mo_wordXor dflags) [aa,bb], | 1091 | res_t <- liftM CmmLocal $ newTemp (cmmExprType dflags aa) | ||

dfeuer: I doubt it matters, but you should be able to use `<$>` rather than `liftM`. | |||||

1098 | CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)] | 1092 | let g3 = catAGraphs [mkAssign res_t aa, | ||

1099 | ], | 1093 | mkAssign (CmmLocal res_r) (neg (CmmReg res_t))] | ||

1100 | mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1) | 1094 | | ||

1101 | ] | 1095 | g4 <- mkCmmIfThenElse (gt aa zero) g2 g3 | ||

1102 | ] | 1096 | | ||

1103 | genericDoubleFabsOp _ _ = panic "genericDoubleFabsOp" | 1097 | emit =<< mkCmmIfThenElse (eq aa zero) g1 g4 | ||

1098 | | ||||

1099 | genericFabsOp _ _ _ = panic "genericFabsOp" | ||||

1104 | 1100 | | |||

1105 | -- These PrimOps are NOPs in Cmm | 1101 | -- These PrimOps are NOPs in Cmm | ||

1106 | 1102 | | |||

1107 | nopOp :: PrimOp -> Bool | 1103 | nopOp :: PrimOp -> Bool | ||

1108 | nopOp Int2WordOp = True | 1104 | nopOp Int2WordOp = True | ||

1109 | nopOp Word2IntOp = True | 1105 | nopOp Word2IntOp = True | ||

1110 | nopOp Int2AddrOp = True | 1106 | nopOp Int2AddrOp = True | ||

1111 | nopOp Addr2IntOp = True | 1107 | nopOp Addr2IntOp = True | ||

▲ Show 20 Lines • Show All 1121 Lines • Show Last 20 Lines |

I doubt it matters, but you should be able to use

<$>rather thanliftM.