Add a Word add-with-carry primop
authorIan Lynagh <igloo@earth.li>
Thu, 23 Feb 2012 19:57:57 +0000 (19:57 +0000)
committerIan Lynagh <igloo@earth.li>
Thu, 23 Feb 2012 19:59:20 +0000 (19:59 +0000)
No special-casing in any NCGs yet

16 files changed:
compiler/cmm/CmmCvt.hs
compiler/cmm/CmmMachOp.hs
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmType.hs
compiler/cmm/OldCmm.hs
compiler/cmm/OldCmmUtils.hs
compiler/cmm/OldPprCmm.hs
compiler/cmm/PprC.hs
compiler/codeGen/CgClosure.lhs
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 1c09599..80c6079 100644 (file)
@@ -37,7 +37,7 @@ get_conv (PrimTarget _)       = NativeNodeCall -- JD: SUSPICIOUS
 get_conv (ForeignTarget _ fc) = Foreign fc
 
 cmm_target :: ForeignTarget -> Old.CmmCallTarget
-cmm_target (PrimTarget op) = Old.CmmPrim op
+cmm_target (PrimTarget op) = Old.CmmPrim op Nothing
 cmm_target (ForeignTarget e (ForeignConvention cc _ _)) = Old.CmmCallee e cc
 
 ofZgraph :: CmmGraph -> Old.ListGraph Old.CmmStmt
index d88d104..3deb4fe 100644 (file)
@@ -442,6 +442,7 @@ data CallishMachOp
 
   | MO_S_QuotRem Width
   | MO_U_QuotRem Width
+  | MO_Add2 Width
 
   | MO_WriteBarrier
   | MO_Touch         -- Keep variables live (when using interior pointers)
index ae715a9..8066c60 100644 (file)
@@ -61,7 +61,7 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
                 stmt m (CmmStore e1 e2) = expr (expr m e1) e2
                 stmt m (CmmCall c _ as _) = f (actuals m as) c
                     where f m (CmmCallee e _) = expr m e
-                          f m (CmmPrim _) = m
+                          f m (CmmPrim _ _) = m
                 stmt m (CmmBranch b) = b:m
                 stmt m (CmmCondBranch e b) = b:(expr m e)
                 stmt m (CmmSwitch e bs) = catMaybes bs ++ expr m e
@@ -269,7 +269,7 @@ inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e
 inlineStmt u a (CmmCall target regs es ret)
    = CmmCall (infn target) regs es' ret
    where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv
-         infn (CmmPrim p) = CmmPrim p
+         infn (CmmPrim p m) = CmmPrim p m
          es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
index 029c332..64b2ae4 100644 (file)
@@ -912,13 +912,13 @@ primCall results_code name args_code vols safety
                case safety of
                  CmmUnsafe ->
                    code (emitForeignCall' PlayRisky results
-                     (CmmPrim p) args vols NoC_SRT CmmMayReturn)
+                     (CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn)
                  CmmSafe srt ->
                    code (emitForeignCall' PlaySafe results 
-                     (CmmPrim p) args vols NoC_SRT CmmMayReturn) where
+                     (CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn) where
                  CmmInterruptible ->
                    code (emitForeignCall' PlayInterruptible results 
-                     (CmmPrim p) args vols NoC_SRT CmmMayReturn)
+                     (CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn)
 
 doStore :: CmmType -> ExtFCode CmmExpr  -> ExtFCode CmmExpr -> ExtCode
 doStore rep addr_code val_code
index 2727754..59455d3 100644 (file)
@@ -10,6 +10,7 @@ module CmmType
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
     , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+    , halfWordMask
     , narrowU, narrowS
    )
 where
@@ -163,6 +164,11 @@ halfWordWidth | wORD_SIZE == 4 = W16
               | wORD_SIZE == 8 = W32
               | otherwise      = panic "MachOp.halfWordRep: Unknown word size"
 
+halfWordMask :: Integer
+halfWordMask | wORD_SIZE == 4 = 0xFFFF
+             | wORD_SIZE == 8 = 0xFFFFFFFF
+             | otherwise      = panic "MachOp.halfWordMask: Unknown word size"
+
 -- cIntRep is the Width for a C-language 'int'
 cIntWidth, cLongWidth :: Width
 #if SIZEOF_INT == 4
index 7b5917d..97fdd4a 100644 (file)
@@ -293,5 +293,8 @@ data CmmCallTarget
   | CmmPrim             -- Call a "primitive" (eg. sin, cos)
         CallishMachOp           -- These might be implemented as inline
                                 -- code by the backend.
-  deriving Eq
+        -- If we don't know how to implement the
+        -- mach op, then we can replace it with
+        -- this list of statements:
+        (Maybe ([HintedCmmFormal] -> [HintedCmmActual] -> [CmmStmt]))
 
index efdeeff..0ec7a25 100644 (file)
@@ -12,8 +12,6 @@ module OldCmmUtils(
 
         maybeAssignTemp, loadArgsIntoTemps,
 
-        expandCallishMachOp,
-
         module CmmUtils,
   ) where
 
@@ -99,15 +97,3 @@ maybeAssignTemp uniques e
     | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
     where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))
 
-expandCallishMachOp :: CallishMachOp -> [HintedCmmFormal] -> [HintedCmmActual]
-                    -> Maybe [CmmStmt]
-expandCallishMachOp (MO_S_QuotRem width) [CmmHinted res_q _, CmmHinted res_r _] args
-    = 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 4b1da0b..24821b6 100644 (file)
@@ -139,7 +139,7 @@ pprStmt platform stmt = case stmt of
                       _           -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
 
     -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
-    CmmCall (CmmPrim op) results args ret ->
+    CmmCall (CmmPrim op _) results args ret ->
         pprStmt platform (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
                                   results args ret)
         where
index f3c762c..fc4a2de 100644 (file)
@@ -28,7 +28,6 @@ import BlockId
 import CLabel
 import ForeignCall
 import OldCmm
-import OldCmmUtils
 import OldPprCmm ()
 
 -- Utils
@@ -238,11 +237,10 @@ pprStmt platform stmt = case stmt of
                     pprCall platform cast_fn cconv results args <> semi)
                         -- for a dynamic call, no declaration is necessary.
 
-    CmmCall (CmmPrim op) results args _ret
-     | Just stmts <- expandCallishMachOp op results args ->
-        vcat $ map (pprStmt platform) stmts
+    CmmCall (CmmPrim _ (Just mkStmts)) results args _ret ->
+        vcat $ map (pprStmt platform) (mkStmts results args)
 
-    CmmCall (CmmPrim op) results args _ret ->
+    CmmCall (CmmPrim op _) results args _ret ->
         pprCall platform ppr_fn CCallConv results args'
         where
         ppr_fn = pprCallishMachOp_for_C op
@@ -665,6 +663,7 @@ pprCallishMachOp_for_C mop
 
         MO_S_QuotRem {} -> unsupported
         MO_U_QuotRem {} -> unsupported
+        MO_Add2      {} -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
                             ++ " not supported!")
index d6537c2..4d1ce50 100644 (file)
@@ -485,7 +485,7 @@ emitBlackHoleCode is_single_entry = do
     stmtsC [
        CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
                 (CmmReg (CmmGlobal CurrentTSO)),
-       CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmMayReturn,
+       CmmCall (CmmPrim MO_WriteBarrier Nothing) [] [] CmmMayReturn,
        CmmStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo))
      ]
 \end{code}
index 9ec99bf..0b0b82c 100644 (file)
@@ -430,7 +430,7 @@ emitPrimOp [res] op args live
    = do vols <- getVolatileRegs live
         emitForeignCall' PlayRisky
            [CmmHinted res NoHint]
-           (CmmPrim prim)
+           (CmmPrim prim Nothing)
            [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
            (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
@@ -441,7 +441,14 @@ emitPrimOp [res] op args live
      stmtC stmt
 
 emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
-    = let stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth))
+    = let genericImpl [CmmHinted res_q _, CmmHinted res_r _]
+                      [CmmHinted arg_x _, CmmHinted arg_y _]
+              = [CmmAssign (CmmLocal res_q)
+                           (CmmMachOp (MO_S_Quot wordWidth) [arg_x, arg_y]),
+                 CmmAssign (CmmLocal res_r)
+                           (CmmMachOp (MO_S_Rem  wordWidth) [arg_x, arg_y])]
+          genericImpl _ _ = panic "emitPrimOp IntQuotRemOp generic: bad lengths"
+          stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth) (Just genericImpl))
                          [CmmHinted res_q NoHint,
                           CmmHinted res_r NoHint]
                          [CmmHinted arg_x NoHint,
@@ -449,17 +456,60 @@ emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
                          CmmMayReturn
       in stmtC stmt
 emitPrimOp [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
-    = let stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth))
+    = let genericImpl [CmmHinted res_q _, CmmHinted res_r _]
+                      [CmmHinted arg_x _, CmmHinted arg_y _]
+              = [CmmAssign (CmmLocal res_q)
+                           (CmmMachOp (MO_U_Quot wordWidth) [arg_x, arg_y]),
+                 CmmAssign (CmmLocal res_r)
+                           (CmmMachOp (MO_U_Rem  wordWidth) [arg_x, arg_y])]
+          genericImpl _ _ = panic "emitPrimOp WordQuotRemOp generic: bad lengths"
+          stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth) (Just genericImpl))
                          [CmmHinted res_q NoHint,
                           CmmHinted res_r NoHint]
                          [CmmHinted arg_x NoHint,
                           CmmHinted arg_y NoHint]
                          CmmMayReturn
       in stmtC stmt
+emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
+ = do r1 <- newLocalReg (cmmExprType arg_x)
+      r2 <- newLocalReg (cmmExprType arg_x)
+      -- 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 (CmmLocal r1)
+                  (add (bottomHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign (CmmLocal r2)
+                  (add (topHalf (CmmReg (CmmLocal r1)))
+                       (add (topHalf arg_x) (topHalf arg_y))),
+              CmmAssign (CmmLocal res_h)
+                  (topHalf (CmmReg (CmmLocal r2))),
+              CmmAssign (CmmLocal res_l)
+                  (or (toTopHalf (CmmReg (CmmLocal r2)))
+                      (bottomHalf (CmmReg (CmmLocal r1))))]
+               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]
+                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+                     hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+                                          wordWidth)
+                     hwm = CmmLit (CmmInt halfWordMask wordWidth)
+          genericImpl _ _ = panic "emitPrimOp WordAdd2Op generic: bad lengths"
+          stmt = CmmCall (CmmPrim (MO_Add2 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)
 
+newLocalReg :: CmmType -> FCode LocalReg
+newLocalReg t = do u <- newUnique
+                   return $ LocalReg u t
 
 -- These PrimOps are NOPs in Cmm
 
@@ -906,7 +956,7 @@ emitMemcpyCall dst src n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memcpy)
+        (CmmPrim MO_Memcpy Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted src AddrHint)
         , (CmmHinted n NoHint)
@@ -923,7 +973,7 @@ emitMemmoveCall dst src n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memmove)
+        (CmmPrim MO_Memmove Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted src AddrHint)
         , (CmmHinted n NoHint)
@@ -941,7 +991,7 @@ emitMemsetCall dst c n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memset)
+        (CmmPrim MO_Memset Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted c NoHint)
         , (CmmHinted n NoHint)
@@ -973,7 +1023,7 @@ emitPopCntCall res x width live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [CmmHinted res NoHint]
-        (CmmPrim (MO_PopCnt width))
+        (CmmPrim (MO_PopCnt width) Nothing)
         [(CmmHinted x NoHint)]
         (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
index 78df373..0df0fe3 100644 (file)
@@ -15,7 +15,6 @@ import BlockId
 import CgUtils ( activeStgRegs, callerSaves )
 import CLabel
 import OldCmm
-import OldCmmUtils
 import qualified OldPprCmm as PprCmm
 
 import DynFlags
@@ -173,7 +172,7 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
 
 -- Write barrier needs to be handled specially as it is implemented as an LLVM
 -- intrinsic function.
-genCall env (CmmPrim MO_WriteBarrier) _ _ _
+genCall env (CmmPrim MO_WriteBarrier _) _ _ _
  | platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
     = return (env, nilOL, [])
  | getLlvmVer env > 29 = barrier env
@@ -183,7 +182,7 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _
 -- types and things like Word8 are backed by an i32 and just present a logical
 -- i8 range. So we must handle conversions from i32 to i8 explicitly as LLVM
 -- is strict about types.
-genCall env t@(CmmPrim (MO_PopCnt w)) [CmmHinted dst _] args _ = do
+genCall env t@(CmmPrim (MO_PopCnt w) _) [CmmHinted dst _] args _ = do
     let width = widthToLlvmInt w
         dstTy = cmmToLlvmType $ localRegType dst
         funTy = \n -> LMFunction $ LlvmFunctionDecl n ExternallyVisible
@@ -203,9 +202,9 @@ genCall env t@(CmmPrim (MO_PopCnt w)) [CmmHinted dst _] args _ = do
 
 -- Handle memcpy function specifically since llvm's intrinsic version takes
 -- some extra parameters.
-genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy ||
-                                                  op == MO_Memset ||
-                                                  op == MO_Memmove = do
+genCall env t@(CmmPrim op _) [] args CmmMayReturn | op == MO_Memcpy ||
+                                                    op == MO_Memset ||
+                                                    op == MO_Memmove = do
     let (isVolTy, isVolVal) = if getLlvmVer env >= 28
                                  then ([i1], [mkIntLit i1 0]) else ([], [])
         argTy | op == MO_Memset = [i8Ptr, i8,    llvmWord, i32] ++ isVolTy
@@ -223,9 +222,8 @@ genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy ||
                 `appOL` trashStmts `snocOL` call
     return (env2, stmts, top1 ++ top2)
 
-genCall env (CmmPrim op) results args _
- | Just stmts <- expandCallishMachOp op results args
-    = stmtsToInstrs env stmts (nilOL, [])
+genCall env (CmmPrim _ (Just mkStmts)) results args _
+    = stmtsToInstrs env (mkStmts results args) (nilOL, [])
 
 -- Handle all other foreign calls and prim ops.
 genCall env target res args ret = do
@@ -245,7 +243,7 @@ genCall env target res args ret = do
     -- extract Cmm call convention
     let cconv = case target of
             CmmCallee _ conv -> conv
-            CmmPrim   _      -> PrimCallConv
+            CmmPrim   _ _    -> PrimCallConv
 
     -- translate to LLVM call convention
     let lmconv = case cconv of
@@ -342,7 +340,7 @@ getFunPtr env funTy targ = case targ of
         (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
         return (env', v2, stmts `snocOL` s1, top)
 
-    CmmPrim mop -> litCase $ cmmPrimOpFunctions env mop
+    CmmPrim mop -> litCase $ cmmPrimOpFunctions env mop
 
     where
         litCase name = do
@@ -476,6 +474,7 @@ cmmPrimOpFunctions env mop
 
     MO_S_QuotRem {} -> unsupported
     MO_U_QuotRem {} -> unsupported
+    MO_Add2 {}      -> unsupported
     MO_WriteBarrier -> unsupported
     MO_Touch        -> unsupported
 
index 169cd0c..9974fb5 100644 (file)
@@ -42,7 +42,6 @@ import Platform
 import BlockId
 import PprCmm           ( pprExpr )
 import OldCmm
-import OldCmmUtils
 import CLabel
 
 -- The rest:
@@ -899,12 +898,11 @@ genCCall'
 -}
 
 
-genCCall' _ (CmmPrim MO_WriteBarrier) _ _
+genCCall' _ (CmmPrim MO_WriteBarrier _) _ _
  = return $ unitOL LWSYNC
 
-genCCall' _ (CmmPrim op) results args
- | Just stmts <- expandCallishMachOp op results args
-    = stmtsToInstrs stmts
+genCCall' _ (CmmPrim _ (Just mkStmts)) results args
+    = stmtsToInstrs (mkStmts results args)
 
 genCCall' gcp target dest_regs argsAndHints
   = ASSERT (not $ any (`elem` [II16]) $ map cmmTypeSize argReps)
@@ -919,7 +917,7 @@ genCCall' gcp target dest_regs argsAndHints
         (labelOrExpr, reduceToFF32) <- case target of
             CmmCallee (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False)
             CmmCallee expr _ -> return  (Right expr, False)
-            CmmPrim mop -> outOfLineMachOp mop
+            CmmPrim mop -> outOfLineMachOp mop
 
         let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
             codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
@@ -948,7 +946,7 @@ genCCall' gcp target dest_regs argsAndHints
                                 GCPLinux -> roundTo 16 finalStack
 
         -- need to remove alignment information
-        argsAndHints' | (CmmPrim mop) <- target,
+        argsAndHints' | (CmmPrim mop _) <- target,
                         (mop == MO_Memcpy ||
                          mop == MO_Memset ||
                          mop == MO_Memmove)
@@ -1149,6 +1147,7 @@ genCCall' gcp target dest_regs argsAndHints
 
                     MO_S_QuotRem {} -> unsupported
                     MO_U_QuotRem {} -> unsupported
+                    MO_Add2 {}      -> unsupported
                     MO_WriteBarrier -> unsupported
                     MO_Touch        -> unsupported
                 unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 6093751..f5ee022 100644 (file)
@@ -39,7 +39,6 @@ import NCGMonad
 -- Our intermediate code:
 import BlockId
 import OldCmm
-import OldCmmUtils
 import PIC
 import Reg
 import CLabel
@@ -381,17 +380,16 @@ genCCall
 --
 -- In the SPARC case we don't need a barrier.
 --
-genCCall (CmmPrim (MO_WriteBarrier)) _ _
+genCCall (CmmPrim (MO_WriteBarrier) _) _ _
  = do   return nilOL
 
-genCCall (CmmPrim op) results args
- | Just stmts <- expandCallishMachOp op results args
-    = stmtsToInstrs stmts
+genCCall (CmmPrim _ (Just mkStmts)) results args
+    = stmtsToInstrs (mkStmts results args)
 
 genCCall target dest_regs argsAndHints
  = do
         -- need to remove alignment information
-        let argsAndHints' | (CmmPrim mop) <- target,
+        let argsAndHints' | (CmmPrim mop _) <- target,
                             (mop == MO_Memcpy ||
                              mop == MO_Memset ||
                              mop == MO_Memmove)
@@ -423,7 +421,7 @@ genCCall target dest_regs argsAndHints
                  -> do  (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
-                CmmPrim mop
+                CmmPrim mop _
                  -> do  res     <- outOfLineMachOp mop
                         lblOrMopExpr <- case res of
                                 Left lbl -> do
@@ -644,6 +642,7 @@ outOfLineMachOp_table mop
 
         MO_S_QuotRem {} -> unsupported
         MO_U_QuotRem {} -> unsupported
+        MO_Add2 {}      -> unsupported
         MO_WriteBarrier -> unsupported
         MO_Touch        -> unsupported
     where unsupported = panic ("outOfLineCmmOp: " ++ show mop
index 7a3f93d..3963d86 100644 (file)
@@ -41,7 +41,6 @@ import BlockId
 import Module           ( primPackageId )
 import PprCmm           ()
 import OldCmm
-import OldCmmUtils
 import OldPprCmm        ()
 import CLabel
 
@@ -1520,7 +1519,7 @@ genCCall
 -- Unroll memcpy calls if the source and destination pointers are at
 -- least DWORD aligned and the number of bytes to copy isn't too
 -- large.  Otherwise, call C's memcpy.
-genCCall is32Bit (CmmPrim MO_Memcpy) _
+genCCall is32Bit (CmmPrim MO_Memcpy _) _
          [CmmHinted dst _, CmmHinted src _,
           CmmHinted (CmmLit (CmmInt n _)) _,
           CmmHinted (CmmLit (CmmInt align _)) _]
@@ -1563,7 +1562,7 @@ genCCall is32Bit (CmmPrim MO_Memcpy) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (CmmPrim MO_Memset) _
+genCCall _ (CmmPrim MO_Memset _) _
          [CmmHinted dst _,
           CmmHinted (CmmLit (CmmInt c _)) _,
           CmmHinted (CmmLit (CmmInt n _)) _,
@@ -1602,11 +1601,11 @@ genCCall _ (CmmPrim MO_Memset) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (CmmPrim MO_WriteBarrier) _ _ = return nilOL
+genCCall _ (CmmPrim MO_WriteBarrier _) _ _ = return nilOL
         -- write barrier compiles to no code on x86/x86-64;
         -- we keep it this long in order to prevent earlier optimisations.
 
-genCCall is32Bit (CmmPrim (MO_PopCnt width)) dest_regs@[CmmHinted dst _]
+genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
          args@[CmmHinted src _] = do
     sse4_2 <- sse4_2Enabled
     if sse4_2
@@ -1642,10 +1641,10 @@ genCCall32 :: CmmCallTarget            -- function to call
 genCCall32 target dest_regs args =
     case (target, dest_regs) of
     -- void return type prim op
-    (CmmPrim op, []) ->
+    (CmmPrim op _, []) ->
         outOfLineCmmOp op Nothing args
     -- we only cope with a single result for foreign calls
-    (CmmPrim op, [r_hinted@(CmmHinted r _)]) -> do
+    (CmmPrim op _, [r_hinted@(CmmHinted r _)]) -> do
         l1 <- getNewLabelNat
         l2 <- getNewLabelNat
         sse2 <- sse2Enabled
@@ -1677,9 +1676,8 @@ genCCall32 target dest_regs args =
               = panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! ("
                       ++ show (length args) ++ ")"
 
-    (CmmPrim op, results)
-     | Just stmts <- expandCallishMachOp op results args ->
-        stmtsToInstrs stmts
+    (CmmPrim _ (Just mkStmts), results) ->
+        stmtsToInstrs (mkStmts results args)
 
     _ -> do
         let
@@ -1710,7 +1708,7 @@ genCCall32 target dest_regs args =
                -> do { (dyn_r, dyn_c) <- getSomeReg expr
                      ; ASSERT( isWord32 (cmmExprType expr) )
                        return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
-            CmmPrim _
+            CmmPrim _ _
                 -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
                             ++ "probably because too many return values."
 
@@ -1833,20 +1831,19 @@ genCCall64 :: CmmCallTarget            -- function to call
 genCCall64 target dest_regs args =
     case (target, dest_regs) of
 
-    (CmmPrim op, []) ->
+    (CmmPrim op _, []) ->
         -- void return type prim op
         outOfLineCmmOp op Nothing args
 
-    (CmmPrim op, [res]) ->
+    (CmmPrim op _, [res]) ->
         -- 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) _, _) -> divOp True  width dest_regs args
+    (CmmPrim (MO_U_QuotRem width) _, _) -> divOp False width dest_regs args
 
-    (CmmPrim op, results)
-     | Just stmts <- expandCallishMachOp op results args ->
-        stmtsToInstrs stmts
+    (CmmPrim _ (Just mkStmts), results) ->
+        stmtsToInstrs (mkStmts results args)
 
     _ -> genCCall64' target dest_regs args
 
@@ -1915,7 +1912,7 @@ genCCall64' target dest_regs args = do
         CmmCallee expr conv
            -> do (dyn_r, dyn_c) <- getSomeReg expr
                  return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
-        CmmPrim _
+        CmmPrim _ _
             -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
                         ++ "probably because too many return values."
 
@@ -2091,6 +2088,7 @@ outOfLineCmmOp mop res args
 
               MO_S_QuotRem {} -> unsupported
               MO_U_QuotRem {} -> unsupported
+              MO_Add2 {}      -> unsupported
               MO_WriteBarrier -> unsupported
               MO_Touch        -> unsupported
         unsupported = panic ("outOfLineCmmOp: " ++ show mop
index baedd14..69503b1 100644 (file)
@@ -269,6 +269,10 @@ primtype Word#
 primop   WordAddOp   "plusWord#"   Dyadic   Word# -> Word# -> Word#
    with commutable = True
 
+primop   WordAdd2Op  "plusWord2#"  GenPrimOp
+   Word# -> Word# -> (# Word#, Word# #)
+   with commutable = True
+
 primop   WordSubOp   "minusWord#"   Dyadic   Word# -> Word# -> Word#
 
 primop   WordMulOp   "timesWord#"   Dyadic   Word# -> Word# -> Word#