diff options
Diffstat (limited to 'compiler/codeGen/CgPrimOp.hs')
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 0b0b82cc29..c23608de36 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -33,6 +33,8 @@ import Outputable import FastString import StaticFlags +import Control.Monad + -- --------------------------------------------------------------------------- -- Code generation for PrimOps @@ -503,6 +505,52 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _ CmmHinted arg_y NoHint] CmmMayReturn stmtC stmt +emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _ + = do let t = cmmExprType arg_x + xlyl <- liftM CmmLocal $ newLocalReg t + xlyh <- liftM CmmLocal $ newLocalReg t + xhyl <- liftM CmmLocal $ newLocalReg t + r <- liftM CmmLocal $ newLocalReg t + -- This generic implementation is very simple and slow. We might + -- well be able to do better, but for now this at least works. + let genericImpl [CmmHinted res_h _, CmmHinted res_l _] + [CmmHinted arg_x _, CmmHinted arg_y _] + = [CmmAssign xlyl + (mul (bottomHalf arg_x) (bottomHalf arg_y)), + CmmAssign xlyh + (mul (bottomHalf arg_x) (topHalf arg_y)), + CmmAssign xhyl + (mul (topHalf arg_x) (bottomHalf arg_y)), + CmmAssign r + (sum [topHalf (CmmReg xlyl), + bottomHalf (CmmReg xhyl), + bottomHalf (CmmReg xlyh)]), + CmmAssign (CmmLocal res_l) + (or (bottomHalf (CmmReg xlyl)) + (toTopHalf (CmmReg r))), + CmmAssign (CmmLocal res_h) + (sum [mul (topHalf arg_x) (topHalf arg_y), + bottomHalf (CmmReg xhyl), + bottomHalf (CmmReg xlyh), + topHalf (CmmReg r)])] + where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww] + toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww] + bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm] + add x y = CmmMachOp (MO_Add wordWidth) [x, y] + sum = foldl1 add + mul x y = CmmMachOp (MO_Mul wordWidth) [x, y] + or x y = CmmMachOp (MO_Or wordWidth) [x, y] + hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth)) + wordWidth) + hwm = CmmLit (CmmInt halfWordMask wordWidth) + genericImpl _ _ = panic "emitPrimOp WordMul2Op generic: bad lengths" + stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl)) + [CmmHinted res_h NoHint, + CmmHinted res_l NoHint] + [CmmHinted arg_x NoHint, + CmmHinted arg_y NoHint] + CmmMayReturn + stmtC stmt emitPrimOp _ op _ _ = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op) |