Commit 5136d64e authored by Ian Lynagh's avatar Ian Lynagh

Add a quotRemWord2 primop

It allows you to do
    (high, low) `quotRem` d
provided high < d.

Currently only has an inefficient fallback implementation.
parent 6508697f
......@@ -442,6 +442,7 @@ data CallishMachOp
| MO_S_QuotRem Width
| MO_U_QuotRem Width
| MO_U_QuotRem2 Width
| MO_Add2 Width
| MO_U_Mul2 Width
......
......@@ -661,11 +661,12 @@ pprCallishMachOp_for_C mop
MO_Memmove -> ptext (sLit "memmove")
(MO_PopCnt w) -> ptext (sLit $ popCntLabel w)
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_Touch -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_Touch -> unsupported
where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
++ " not supported!")
......
......@@ -468,6 +468,59 @@ emitPrimOp [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
CmmHinted arg_y NoHint]
CmmMayReturn
in stmtC stmt
emitPrimOp [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
= do let ty = cmmExprType arg_x_high
shl x i = CmmMachOp (MO_Shl wordWidth) [x, i]
shr x i = CmmMachOp (MO_U_Shr wordWidth) [x, i]
or x y = CmmMachOp (MO_Or wordWidth) [x, y]
ge x y = CmmMachOp (MO_U_Ge wordWidth) [x, y]
ne x y = CmmMachOp (MO_Ne wordWidth) [x, y]
minus x y = CmmMachOp (MO_Sub wordWidth) [x, y]
times x y = CmmMachOp (MO_Mul wordWidth) [x, y]
zero = lit 0
one = lit 1
negone = lit (fromIntegral (widthInBits wordWidth) - 1)
lit i = CmmLit (CmmInt i wordWidth)
f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode [CmmStmt]
f 0 acc high _ = return [CmmAssign (CmmLocal res_q) acc,
CmmAssign (CmmLocal res_r) high]
f i acc high low =
do roverflowedBit <- newLocalReg ty
rhigh' <- newLocalReg ty
rhigh'' <- newLocalReg ty
rlow' <- newLocalReg ty
risge <- newLocalReg ty
racc' <- newLocalReg ty
let high' = CmmReg (CmmLocal rhigh')
isge = CmmReg (CmmLocal risge)
overflowedBit = CmmReg (CmmLocal roverflowedBit)
let this = [CmmAssign (CmmLocal roverflowedBit)
(shr high negone),
CmmAssign (CmmLocal rhigh')
(or (shl high one) (shr low negone)),
CmmAssign (CmmLocal rlow')
(shl low one),
CmmAssign (CmmLocal risge)
(or (overflowedBit `ne` zero)
(high' `ge` arg_y)),
CmmAssign (CmmLocal rhigh'')
(high' `minus` (arg_y `times` isge)),
CmmAssign (CmmLocal racc')
(or (shl acc one) isge)]
rest <- f (i - 1) (CmmReg (CmmLocal racc'))
(CmmReg (CmmLocal rhigh''))
(CmmReg (CmmLocal rlow'))
return (this ++ rest)
genericImpl <- f (widthInBits wordWidth) zero arg_x_high arg_x_low
let stmt = CmmCall (CmmPrim (MO_U_QuotRem2 wordWidth) (Just genericImpl))
[CmmHinted res_q NoHint,
CmmHinted res_r NoHint]
[CmmHinted arg_x_high NoHint,
CmmHinted arg_x_low NoHint,
CmmHinted arg_y NoHint]
CmmMayReturn
stmtC stmt
emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
= do r1 <- newLocalReg (cmmExprType arg_x)
r2 <- newLocalReg (cmmExprType arg_x)
......
......@@ -473,12 +473,13 @@ cmmPrimOpFunctions env mop
(MO_PopCnt w) -> fsLit $ "llvm.ctpop." ++ show (widthToLlvmInt w)
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
where
intrinTy1 = (if getLlvmVer env >= 28
......
......@@ -1145,12 +1145,13 @@ genCCall' gcp target dest_regs argsAndHints
MO_PopCnt w -> (fsLit $ popCntLabel w, False)
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
++ " not supported")
......
......@@ -640,12 +640,13 @@ outOfLineMachOp_table mop
MO_PopCnt w -> fsLit $ popCntLabel w
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
where unsupported = panic ("outOfLineCmmOp: " ++ show mop
++ " not supported here")
......@@ -2225,12 +2225,13 @@ outOfLineCmmOp mop res args
MO_PopCnt _ -> fsLit "popcnt"
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
MO_Add2 {} -> unsupported
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
++ "not supported here")
......
......@@ -294,6 +294,12 @@ primop WordQuotRemOp "quotRemWord#" GenPrimOp
Word# -> Word# -> (# Word#, Word# #)
with can_fail = True
-- Takes high word of dividend, then low word of dividend, then divisor.
-- Requires that high word is not divisible by divisor.
primop WordQuotRem2Op "quotRemWord2#" GenPrimOp
Word# -> Word# -> Word# -> (# Word#, Word# #)
with can_fail = True
primop AndOp "and#" Dyadic Word# -> Word# -> Word#
with commutable = 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