Commit 45eb0a42 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add a 2-word-multiply operator

Currently no NCGs support it
parent d8228fd4
...@@ -442,7 +442,8 @@ data CallishMachOp ...@@ -442,7 +442,8 @@ data CallishMachOp
| MO_S_QuotRem Width | MO_S_QuotRem Width
| MO_U_QuotRem Width | MO_U_QuotRem Width
| MO_Add2 Width | MO_Add2 Width
| MO_U_Mul2 Width
| MO_WriteBarrier | MO_WriteBarrier
| MO_Touch -- Keep variables live (when using interior pointers) | MO_Touch -- Keep variables live (when using interior pointers)
......
...@@ -664,6 +664,7 @@ pprCallishMachOp_for_C mop ...@@ -664,6 +664,7 @@ pprCallishMachOp_for_C mop
MO_S_QuotRem {} -> unsupported MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_Touch -> unsupported MO_Touch -> unsupported
where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
++ " not supported!") ++ " not supported!")
......
...@@ -33,6 +33,8 @@ import Outputable ...@@ -33,6 +33,8 @@ import Outputable
import FastString import FastString
import StaticFlags import StaticFlags
import Control.Monad
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Code generation for PrimOps -- Code generation for PrimOps
...@@ -503,6 +505,52 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _ ...@@ -503,6 +505,52 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
CmmHinted arg_y NoHint] CmmHinted arg_y NoHint]
CmmMayReturn CmmMayReturn
stmtC stmt 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 _ _ emitPrimOp _ op _ _
= pprPanic "emitPrimOp: can't translate PrimOp" (ppr op) = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
......
...@@ -475,6 +475,7 @@ cmmPrimOpFunctions env mop ...@@ -475,6 +475,7 @@ cmmPrimOpFunctions env mop
MO_S_QuotRem {} -> unsupported MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported MO_WriteBarrier -> unsupported
MO_Touch -> unsupported MO_Touch -> unsupported
......
...@@ -1148,6 +1148,7 @@ genCCall' gcp target dest_regs argsAndHints ...@@ -1148,6 +1148,7 @@ genCCall' gcp target dest_regs argsAndHints
MO_S_QuotRem {} -> unsupported MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported MO_WriteBarrier -> unsupported
MO_Touch -> unsupported MO_Touch -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop unsupported = panic ("outOfLineCmmOp: " ++ show mop
......
...@@ -643,6 +643,7 @@ outOfLineMachOp_table mop ...@@ -643,6 +643,7 @@ outOfLineMachOp_table mop
MO_S_QuotRem {} -> unsupported MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported MO_WriteBarrier -> unsupported
MO_Touch -> unsupported MO_Touch -> unsupported
where unsupported = panic ("outOfLineCmmOp: " ++ show mop where unsupported = panic ("outOfLineCmmOp: " ++ show mop
......
...@@ -2102,6 +2102,7 @@ outOfLineCmmOp mop res args ...@@ -2102,6 +2102,7 @@ outOfLineCmmOp mop res args
MO_S_QuotRem {} -> unsupported MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported MO_WriteBarrier -> unsupported
MO_Touch -> unsupported MO_Touch -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop unsupported = panic ("outOfLineCmmOp: " ++ show mop
......
...@@ -278,6 +278,10 @@ primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word# ...@@ -278,6 +278,10 @@ primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word# primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
with commutable = True with commutable = True
primop WordMul2Op "timesWord2#" GenPrimOp
Word# -> Word# -> (# Word#, Word# #)
with commutable = True
primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word# primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
with can_fail = True with can_fail = True
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment