summaryrefslogtreecommitdiff
path: root/compiler/nativeGen
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2012-02-24 14:09:09 +0000
committerIan Lynagh <igloo@earth.li>2012-02-24 14:09:09 +0000
commit778ca5de01f1f6622101317eed0d5befcfba0c46 (patch)
treee6292b0fc8b83b3edfe27f894278b88a8b7b468b /compiler/nativeGen
parent16d8cddd359ea39355418528604ceac5493aaa52 (diff)
downloadhaskell-778ca5de01f1f6622101317eed0d5befcfba0c46.tar.gz
Add x86 implementations of the quotRem, Mul2 and Add2 primops
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r--compiler/nativeGen/X86/CodeGen.hs61
1 files changed, 59 insertions, 2 deletions
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 84f443eef2..89229226af 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1673,13 +1673,70 @@ genCCall32 target dest_regs args =
return (any (getRegisterReg False (CmmLocal r)))
actuallyInlineFloatOp _ _ args
- = panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! ("
+ = 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_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+ case args of
+ [CmmHinted arg_x _, CmmHinted arg_y _] ->
+ do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
+ lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
+ let size = intSize width
+ reg_l = getRegisterReg True (CmmLocal res_l)
+ reg_h = getRegisterReg True (CmmLocal res_h)
+ code = hCode reg_h `appOL`
+ lCode reg_l `snocOL`
+ ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
+ return code
+ _ -> panic "genCCall32: Wrong number of arguments/results for add2"
+ (CmmPrim (MO_U_Mul2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
+ case args of
+ [CmmHinted arg_x _, CmmHinted arg_y _] ->
+ do (y_reg, y_code) <- getRegOrMem arg_y
+ x_code <- getAnyReg arg_x
+ let size = intSize width
+ reg_h = getRegisterReg True (CmmLocal res_h)
+ reg_l = getRegisterReg True (CmmLocal res_l)
+ code = y_code `appOL`
+ x_code rax `appOL`
+ toOL [MUL2 size y_reg,
+ MOV size (OpReg rdx) (OpReg reg_h),
+ MOV size (OpReg rax) (OpReg reg_l)]
+ return code
+ _ -> panic "genCCall32: Wrong number of arguments/results for add2"
+
(CmmPrim _ (Just mkStmts), results) ->
stmtsToInstrs (mkStmts results args)
- _ -> do
+ _ -> genCCall32' target dest_regs args
+
+ where divOp signed width [CmmHinted res_q _, CmmHinted res_r _]
+ [CmmHinted arg_x _, CmmHinted arg_y _]
+ = do let size = intSize width
+ reg_q = getRegisterReg True (CmmLocal res_q)
+ reg_r = getRegisterReg True (CmmLocal res_r)
+ widen | signed = CLTD size
+ | otherwise = XOR size (OpReg rdx) (OpReg rdx)
+ instr | signed = IDIV
+ | otherwise = DIV
+ (y_reg, y_code) <- getRegOrMem arg_y
+ x_code <- getAnyReg arg_x
+ return $ y_code `appOL`
+ x_code rax `appOL`
+ toOL [widen,
+ 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"
+
+genCCall32' :: CmmCallTarget -- function to call
+ -> [HintedCmmFormal] -- where to put the result
+ -> [HintedCmmActual] -- arguments (of mixed type)
+ -> NatM InstrBlock
+genCCall32' target dest_regs args = do
let
-- Align stack to 16n for calls, assuming a starting stack
-- alignment of 16n - word_size on procedure entry. Which we