Add a 2-word-multiply operator
authorIan Lynagh <igloo@earth.li>
Fri, 24 Feb 2012 00:34:46 +0000 (00:34 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 24 Feb 2012 00:34:46 +0000 (00:34 +0000)
Currently no NCGs support it

compiler/cmm/CmmMachOp.hs
compiler/cmm/PprC.hs
compiler/codeGen/CgPrimOp.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/prelude/primops.txt.pp

index 3deb4fe..d9484a6 100644 (file)
@@ -442,7 +442,8 @@ data CallishMachOp
 
   | MO_S_QuotRem Width
   | MO_U_QuotRem Width
-  | MO_Add2 Width
+  | MO_Add2      Width
+  | MO_U_Mul2    Width
 
   | MO_WriteBarrier
   | MO_Touch         -- Keep variables live (when using interior pointers)
index fc4a2de..3e28484 100644 (file)
@@ -664,6 +664,7 @@ pprCallishMachOp_for_C mop
         MO_S_QuotRem {} -> unsupported
         MO_U_QuotRem {} -> unsupported
         MO_Add2      {} -> unsupported
+        MO_U_Mul2    {} -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
                             ++ " not supported!")
index 0b0b82c..c23608d 100644 (file)
@@ -33,6 +33,8 @@ import Outputable
 import FastString
 import StaticFlags
 
+import Control.Monad
+
 -- ---------------------------------------------------------------------------
 -- Code generation for PrimOps
 
@@ -503,6 +505,52 @@ emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
                           CmmHinted arg_y NoHint]
                          CmmMayReturn
       stmtC stmt
+emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _
+ = do let t = cmmExprType arg_x
+      xlyl <- liftM CmmLocal $ newLocalReg t
+      xlyh <- liftM CmmLocal $ newLocalReg t
+      xhyl <- liftM CmmLocal $ newLocalReg t
+      r    <- liftM CmmLocal $ newLocalReg t
+      -- This generic implementation is very simple and slow. We might
+      -- well be able to do better, but for now this at least works.
+      let genericImpl [CmmHinted res_h _, CmmHinted res_l _]
+                      [CmmHinted arg_x _, CmmHinted arg_y _]
+           = [CmmAssign xlyl
+                  (mul (bottomHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign xlyh
+                  (mul (bottomHalf arg_x) (topHalf arg_y)),
+              CmmAssign xhyl
+                  (mul (topHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign r
+                  (sum [topHalf    (CmmReg xlyl),
+                        bottomHalf (CmmReg xhyl),
+                        bottomHalf (CmmReg xlyh)]),
+              CmmAssign (CmmLocal res_l)
+                  (or (bottomHalf (CmmReg xlyl))
+                      (toTopHalf (CmmReg r))),
+              CmmAssign (CmmLocal res_h)
+                  (sum [mul (topHalf arg_x) (topHalf arg_y),
+                        bottomHalf (CmmReg xhyl),
+                        bottomHalf (CmmReg xlyh),
+                        topHalf    (CmmReg r)])]
+               where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
+                     toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
+                     bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
+                     add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+                     sum = foldl1 add
+                     mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
+                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+                     hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+                                          wordWidth)
+                     hwm = CmmLit (CmmInt halfWordMask wordWidth)
+          genericImpl _ _ = panic "emitPrimOp WordMul2Op generic: bad lengths"
+          stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl))
+                         [CmmHinted res_h NoHint,
+                          CmmHinted res_l NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      stmtC stmt
 
 emitPrimOp _ op _ _
  = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
index 0df0fe3..cfd0ac2 100644 (file)
@@ -475,6 +475,7 @@ cmmPrimOpFunctions env mop
     MO_S_QuotRem {} -> unsupported
     MO_U_QuotRem {} -> unsupported
     MO_Add2 {}      -> unsupported
+    MO_U_Mul2 {}    -> unsupported
     MO_WriteBarrier -> unsupported
     MO_Touch        -> unsupported
 
index 9974fb5..9fff25b 100644 (file)
@@ -1148,6 +1148,7 @@ genCCall' gcp target dest_regs argsAndHints
                     MO_S_QuotRem {} -> unsupported
                     MO_U_QuotRem {} -> unsupported
                     MO_Add2 {}      -> unsupported
+                    MO_U_Mul2 {}    -> unsupported
                     MO_WriteBarrier -> unsupported
                     MO_Touch        -> unsupported
                 unsupported = panic ("outOfLineCmmOp: " ++ show mop
index f5ee022..6646155 100644 (file)
@@ -643,6 +643,7 @@ outOfLineMachOp_table mop
         MO_S_QuotRem {} -> unsupported
         MO_U_QuotRem {} -> unsupported
         MO_Add2 {}      -> unsupported
+        MO_U_Mul2 {}    -> unsupported
         MO_WriteBarrier -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 41628ee..5f58277 100644 (file)
@@ -2102,6 +2102,7 @@ outOfLineCmmOp mop res args
               MO_S_QuotRem {} -> unsupported
               MO_U_QuotRem {} -> unsupported
               MO_Add2 {}      -> unsupported
+              MO_U_Mul2 {}    -> unsupported
               MO_WriteBarrier -> unsupported
               MO_Touch        -> unsupported
         unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 69503b1..4d452c0 100644 (file)
@@ -278,6 +278,10 @@ primop   WordSubOp   "minusWord#"   Dyadic   Word# -> Word# -> Word#
 primop   WordMulOp   "timesWord#"   Dyadic   Word# -> Word# -> Word#
    with commutable = True
 
+primop   WordMul2Op  "timesWord2#"   GenPrimOp
+   Word# -> Word# -> (# Word#, Word# #)
+   with commutable = True
+
 primop   WordQuotOp   "quotWord#"   Dyadic   Word# -> Word# -> Word#
    with can_fail = True