diff options
| author | Ian Lynagh <igloo@earth.li> | 2012-04-21 15:03:23 +0100 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2012-04-21 15:03:23 +0100 |
| commit | 5136d64e47155070f9c7129b53156545a79b5e00 (patch) | |
| tree | f8a1341382275a461ac286469f1c3341277f25ac /compiler/codeGen | |
| parent | 6508697f398fa4e9241cec88991772eda86e37b3 (diff) | |
| download | haskell-5136d64e47155070f9c7129b53156545a79b5e00.tar.gz | |
Add a quotRemWord2 primop
It allows you to do
(high, low) `quotRem` d
provided high < d.
Currently only has an inefficient fallback implementation.
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 3f1187f6be..9165cf44bc 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -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) |