diff options
author | Ian Lynagh <igloo@earth.li> | 2012-04-21 15:28:27 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2012-04-21 15:28:27 +0100 |
commit | 74b9eb7284a15e67e1283138a0c861808c5a51c5 (patch) | |
tree | cad226befa5aedb460af5e51fcb1b301786059b8 /compiler/nativeGen | |
parent | 5136d64e47155070f9c7129b53156545a79b5e00 (diff) | |
download | haskell-74b9eb7284a15e67e1283138a0c861808c5a51c5.tar.gz |
Add an X86/amd64 implementation for quotRemWord2
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r-- | compiler/nativeGen/X86/CodeGen.hs | 70 |
1 files changed, 50 insertions, 20 deletions
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index c60debab6a..98d5e892ad 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1676,8 +1676,9 @@ genCCall32 target dest_regs args = = panic $ "genCCall32.actuallyInlineFloatOp: bad number of arguments! (" ++ show (length args) ++ ")" - (CmmPrim (MO_S_QuotRem width) _, _) -> divOp True width dest_regs args - (CmmPrim (MO_U_QuotRem width) _, _) -> divOp False width dest_regs args + (CmmPrim (MO_S_QuotRem width) _, _) -> divOp1 True width dest_regs args + (CmmPrim (MO_U_QuotRem width) _, _) -> divOp1 False width dest_regs args + (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 False width dest_regs args (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) -> case args of [CmmHinted arg_x _, CmmHinted arg_y _] -> @@ -1712,8 +1713,18 @@ genCCall32 target dest_regs args = _ -> genCCall32' target dest_regs args - where divOp signed width [CmmHinted res_q _, CmmHinted res_r _] - [CmmHinted arg_x _, CmmHinted arg_y _] + where divOp1 signed width results [CmmHinted arg_x _, CmmHinted arg_y _] + = divOp signed width results Nothing arg_x arg_y + divOp1 _ _ _ _ + = panic "genCCall32: Wrong number of arguments for divOp1" + divOp2 signed width results [CmmHinted arg_x_high _, + CmmHinted arg_x_low _, + CmmHinted arg_y _] + = divOp signed width results (Just arg_x_high) arg_x_low arg_y + divOp2 _ _ _ _ + = panic "genCCall64: Wrong number of arguments for divOp2" + divOp signed width [CmmHinted res_q _, CmmHinted res_r _] + m_arg_x_high arg_x_low arg_y = do let size = intSize width reg_q = getRegisterReg True (CmmLocal res_q) reg_r = getRegisterReg True (CmmLocal res_r) @@ -1722,15 +1733,20 @@ genCCall32 target dest_regs args = instr | signed = IDIV | otherwise = DIV (y_reg, y_code) <- getRegOrMem arg_y - x_code <- getAnyReg arg_x + x_low_code <- getAnyReg arg_x_low + x_high_code <- case m_arg_x_high of + Just arg_x_high -> + getAnyReg arg_x_high + Nothing -> + return $ const $ unitOL widen return $ y_code `appOL` - x_code rax `appOL` - toOL [widen, - instr size y_reg, + x_low_code rax `appOL` + x_high_code rdx `appOL` + toOL [instr size y_reg, MOV size (OpReg rax) (OpReg reg_q), MOV size (OpReg rdx) (OpReg reg_r)] - divOp _ _ _ _ - = panic "genCCall32: Wrong number of arguments/results for divOp" + divOp _ _ _ _ _ _ + = panic "genCCall32: Wrong number of results for divOp" genCCall32' :: CmmCallTarget -- function to call -> [HintedCmmFormal] -- where to put the result @@ -1896,8 +1912,9 @@ genCCall64 target dest_regs args = -- we only cope with a single result for foreign calls outOfLineCmmOp op (Just res) args - (CmmPrim (MO_S_QuotRem width) _, _) -> divOp True width dest_regs args - (CmmPrim (MO_U_QuotRem width) _, _) -> divOp False width dest_regs args + (CmmPrim (MO_S_QuotRem width) _, _) -> divOp1 True width dest_regs args + (CmmPrim (MO_U_QuotRem width) _, _) -> divOp1 False width dest_regs args + (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 False width dest_regs args (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) -> case args of [CmmHinted arg_x _, CmmHinted arg_y _] -> @@ -1935,8 +1952,18 @@ genCCall64 target dest_regs args = let platform = targetPlatform dflags genCCall64' platform target dest_regs args - where divOp signed width [CmmHinted res_q _, CmmHinted res_r _] - [CmmHinted arg_x _, CmmHinted arg_y _] + where divOp1 signed width results [CmmHinted arg_x _, CmmHinted arg_y _] + = divOp signed width results Nothing arg_x arg_y + divOp1 _ _ _ _ + = panic "genCCall64: Wrong number of arguments for divOp1" + divOp2 signed width results [CmmHinted arg_x_high _, + CmmHinted arg_x_low _, + CmmHinted arg_y _] + = divOp signed width results (Just arg_x_high) arg_x_low arg_y + divOp2 _ _ _ _ + = panic "genCCall64: Wrong number of arguments for divOp2" + divOp signed width [CmmHinted res_q _, CmmHinted res_r _] + m_arg_x_high arg_x_low arg_y = do let size = intSize width reg_q = getRegisterReg True (CmmLocal res_q) reg_r = getRegisterReg True (CmmLocal res_r) @@ -1945,15 +1972,18 @@ genCCall64 target dest_regs args = instr | signed = IDIV | otherwise = DIV (y_reg, y_code) <- getRegOrMem arg_y - x_code <- getAnyReg arg_x + x_low_code <- getAnyReg arg_x_low + x_high_code <- case m_arg_x_high of + Just arg_x_high -> getAnyReg arg_x_high + Nothing -> return $ const $ unitOL widen return $ y_code `appOL` - x_code rax `appOL` - toOL [widen, - instr size y_reg, + x_low_code rax `appOL` + x_high_code rdx `appOL` + toOL [instr size y_reg, MOV size (OpReg rax) (OpReg reg_q), MOV size (OpReg rdx) (OpReg reg_r)] - divOp _ _ _ _ - = panic "genCCall64: Wrong number of arguments/results for divOp" + divOp _ _ _ _ _ _ + = panic "genCCall64: Wrong number of results for divOp" genCCall64' :: Platform -> CmmCallTarget -- function to call |