Add a primop for unsigned quotRem; part of #5598
authorIan Lynagh <igloo@earth.li>
Fri, 17 Feb 2012 22:46:27 +0000 (22:46 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 17 Feb 2012 22:46:27 +0000 (22:46 +0000)
Only amd64 has an efficient implementation currently.

compiler/cmm/CmmMachOp.hs
compiler/cmm/OldCmmUtils.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 967f328..d88d104 100644 (file)
@@ -441,6 +441,7 @@ data CallishMachOp
   | MO_F32_Sqrt
 
   | MO_S_QuotRem Width
+  | MO_U_QuotRem Width
 
   | MO_WriteBarrier
   | MO_Touch         -- Keep variables live (when using interior pointers)
index 3fc6fd4..efdeeff 100644 (file)
@@ -105,5 +105,9 @@ expandCallishMachOp (MO_S_QuotRem width) [CmmHinted res_q _, CmmHinted res_r _]
     = Just [CmmAssign (CmmLocal res_q) (CmmMachOp (MO_S_Quot width) args'),
             CmmAssign (CmmLocal res_r) (CmmMachOp (MO_S_Rem  width) args')]
     where args' = map hintlessCmm args
+expandCallishMachOp (MO_U_QuotRem width) [CmmHinted res_q _, CmmHinted res_r _] args
+    = Just [CmmAssign (CmmLocal res_q) (CmmMachOp (MO_U_Quot width) args'),
+            CmmAssign (CmmLocal res_r) (CmmMachOp (MO_U_Rem  width) args')]
+    where args' = map hintlessCmm args
 expandCallishMachOp _ _ _ = Nothing
 
index d636c41..f3c762c 100644 (file)
@@ -664,6 +664,7 @@ pprCallishMachOp_for_C mop
         (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)
 
         MO_S_QuotRem {} -> unsupported
+        MO_U_QuotRem {} -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
                             ++ " not supported!")
index f169c0c..9ec99bf 100644 (file)
@@ -448,6 +448,14 @@ emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
                           CmmHinted arg_y NoHint]
                          CmmMayReturn
       in stmtC stmt
+emitPrimOp [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
+    = let stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth))
+                         [CmmHinted res_q NoHint,
+                          CmmHinted res_r NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      in stmtC stmt
 
 emitPrimOp _ op _ _
  = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
index 98fb8eb..78df373 100644 (file)
@@ -475,6 +475,7 @@ cmmPrimOpFunctions env mop
     (MO_PopCnt w) -> fsLit $ "llvm.ctpop."  ++ show (widthToLlvmInt w)
 
     MO_S_QuotRem {} -> unsupported
+    MO_U_QuotRem {} -> unsupported
     MO_WriteBarrier -> unsupported
     MO_Touch        -> unsupported
 
index db97a8c..169cd0c 100644 (file)
@@ -1148,6 +1148,7 @@ genCCall' gcp target dest_regs argsAndHints
                     MO_PopCnt w  -> (fsLit $ popCntLabel w, False)
 
                     MO_S_QuotRem {} -> unsupported
+                    MO_U_QuotRem {} -> unsupported
                     MO_WriteBarrier -> unsupported
                     MO_Touch        -> unsupported
                 unsupported = panic ("outOfLineCmmOp: " ++ show mop
index f8e71f4..6093751 100644 (file)
@@ -643,6 +643,7 @@ outOfLineMachOp_table mop
         MO_PopCnt w  -> fsLit $ popCntLabel w
 
         MO_S_QuotRem {} -> unsupported
+        MO_U_QuotRem {} -> unsupported
         MO_WriteBarrier -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 7900b3e..ec6bf59 100644 (file)
@@ -1841,24 +1841,31 @@ 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), [CmmHinted res_q _, CmmHinted res_r _]) ->
-        case args of
-        [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)
-               (y_reg, y_code) <- getRegOrMem arg_y
-               x_code <- getAnyReg arg_x
-               return $ y_code `appOL`
-                        x_code rax `appOL`
-                        toOL [CLTD size,
-                              IDIV size y_reg,
-                              MOV size (OpReg rax) (OpReg reg_q),
-                              MOV size (OpReg rdx) (OpReg reg_r)]
-        _ -> panic "genCCall64: Wrong number of arguments for MO_S_QuotRem"
+    (CmmPrim (MO_S_QuotRem width), _) -> divOp True  width dest_regs args
+    (CmmPrim (MO_U_QuotRem width), _) -> divOp False width dest_regs args
 
     _ -> genCCall64' 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 "genCCall64: Wrong number of arguments/results for divOp"
+
 genCCall64' :: CmmCallTarget            -- function to call
             -> [HintedCmmFormal]        -- where to put the result
             -> [HintedCmmActual]        -- arguments (of mixed type)
@@ -2079,6 +2086,7 @@ outOfLineCmmOp mop res args
               MO_PopCnt _  -> fsLit "popcnt"
 
               MO_S_QuotRem {} -> unsupported
+              MO_U_QuotRem {} -> unsupported
               MO_WriteBarrier -> unsupported
               MO_Touch        -> unsupported
         unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 183bd35..baedd14 100644 (file)
@@ -280,6 +280,10 @@ primop   WordQuotOp   "quotWord#"   Dyadic   Word# -> Word# -> Word#
 primop   WordRemOp   "remWord#"   Dyadic   Word# -> Word# -> Word#
    with can_fail = True
 
+primop   WordQuotRemOp "quotRemWord#" GenPrimOp
+   Word# -> Word# -> (# Word#, Word# #)
+   with can_fail = True
+
 primop   AndOp   "and#"   Dyadic   Word# -> Word# -> Word#
    with commutable = True