[commit: ghc] master: Add x86 implementations of the quotRem, Mul2 and Add2 primops (778ca5d)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/778ca5de01f1f6622101317eed0d5befcfba0c46

>---------------------------------------------------------------

commit 778ca5de01f1f6622101317eed0d5befcfba0c46
Author: Ian Lynagh <igloo at earth.li>
Date:   Fri Feb 24 14:09:09 2012 +0000

    Add x86 implementations of the quotRem, Mul2 and Add2 primops

>---------------------------------------------------------------

 compiler/nativeGen/X86/CodeGen.hs |   61 +++++++++++++++++++++++++++++++++++-
 1 files changed, 59 insertions(+), 2 deletions(-)

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 84f443e..8922922 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