Add support for Int64# and Word64#

compiler/codeGen/StgCmmPrim.hs

@@ -906,6 +906,10 @@ callishPrimOpSupported dflags op
                         || llvm      -> Left (MO_S_QuotRem W32)
                      | otherwise     -> Right (genericIntQuotRemOp W32)
 
+      Int64QuotRemOp | (ncg && x86ish)
+                        || llvm      -> Left (MO_S_QuotRem W64)
+                     | otherwise     -> Right (genericIntQuotRemOp W64)
+
       WordQuotRemOp  | ncg && (x86ish || ppc) ->
                          Left (MO_U_QuotRem  (wordWidth dflags))
                      | otherwise      ->
@@ -928,6 +932,10 @@ callishPrimOpSupported dflags op
                         || llvm      -> Left (MO_U_QuotRem W32)
                      | otherwise     -> Right (genericWordQuotRemOp W32)
 
+      Word64QuotRemOp| (ncg && x86ish)
+                        || llvm      -> Left (MO_U_QuotRem W64)
+                     | otherwise     -> Right (genericWordQuotRemOp W64)
+
       WordAdd2Op     | (ncg && (x86ish
                                 || ppc))
                          || llvm      -> Left (MO_Add2       (wordWidth dflags))
@@ -1458,6 +1466,42 @@ translateOp _      Word32LeOp       = Just (MO_U_Le W32)
 translateOp _      Word32LtOp       = Just (MO_U_Lt W32)
 translateOp _      Word32NeOp       = Just (MO_Ne W32)
 
+-- Int64# signed ops
+
+translateOp dflags Int64Extend     = Just (MO_SS_Conv W64 (wordWidth dflags))
+translateOp dflags Int64Narrow     = Just (MO_SS_Conv (wordWidth dflags) W64)
+translateOp _      Int64NegOp      = Just (MO_S_Neg W64)
+translateOp _      Int64AddOp      = Just (MO_Add W64)
+translateOp _      Int64SubOp      = Just (MO_Sub W64)
+translateOp _      Int64MulOp      = Just (MO_Mul W64)
+translateOp _      Int64QuotOp     = Just (MO_S_Quot W64)
+translateOp _      Int64RemOp      = Just (MO_S_Rem W64)
+
+translateOp _      Int64EqOp       = Just (MO_Eq W64)
+translateOp _      Int64GeOp       = Just (MO_S_Ge W64)
+translateOp _      Int64GtOp       = Just (MO_S_Gt W64)
+translateOp _      Int64LeOp       = Just (MO_S_Le W64)
+translateOp _      Int64LtOp       = Just (MO_S_Lt W64)
+translateOp _      Int64NeOp       = Just (MO_Ne W64)
+
+-- Word64# unsigned ops
+
+translateOp dflags Word64Extend     = Just (MO_UU_Conv W64 (wordWidth dflags))
+translateOp dflags Word64Narrow     = Just (MO_UU_Conv (wordWidth dflags) W64)
+translateOp _      Word64NotOp      = Just (MO_Not W64)
+translateOp _      Word64AddOp      = Just (MO_Add W64)
+translateOp _      Word64SubOp      = Just (MO_Sub W64)
+translateOp _      Word64MulOp      = Just (MO_Mul W64)
+translateOp _      Word64QuotOp     = Just (MO_U_Quot W64)
+translateOp _      Word64RemOp      = Just (MO_U_Rem W64)
+
+translateOp _      Word64EqOp       = Just (MO_Eq W64)
+translateOp _      Word64GeOp       = Just (MO_U_Ge W64)
+translateOp _      Word64GtOp       = Just (MO_U_Gt W64)
+translateOp _      Word64LeOp       = Just (MO_U_Le W64)
+translateOp _      Word64LtOp       = Just (MO_U_Lt W64)
+translateOp _      Word64NeOp       = Just (MO_Ne W64)
+
 -- Char# ops
 
 translateOp dflags CharEqOp       = Just (MO_Eq (wordWidth dflags))

compiler/prelude/primops.txt.pp

@@ -565,6 +565,88 @@
 primop Word32LtOp "ltWord32#" Compare Word32# -> Word32# -> Int#
 primop Word32NeOp "neWord32#" Compare Word32# -> Word32# -> Int#
 
+------------------------------------------------------------------------
+section "Int64#"
+        {Operations on 64-bit integers.}
+------------------------------------------------------------------------
+
+primtype Int64#
+
+primop Int64Extend "extendInt64#" GenPrimOp Int64# -> Int#
+primop Int64Narrow "narrowInt64#" GenPrimOp Int# -> Int64#
+
+primop Int64NegOp "negateInt64#" Monadic Int64# -> Int64#
+
+primop Int64AddOp "plusInt64#" Dyadic Int64# -> Int64# -> Int64#
+  with
+    commutable = True
+
+primop Int64SubOp "subInt64#" Dyadic Int64# -> Int64# -> Int64#
+
+primop Int64MulOp "timesInt64#" Dyadic Int64# -> Int64# -> Int64#
+  with
+    commutable = True
+
+primop Int64QuotOp "quotInt64#" Dyadic Int64# -> Int64# -> Int64#
+  with
+    can_fail = True
+
+primop Int64RemOp "remInt64#" Dyadic Int64# -> Int64# -> Int64#
+  with
+    can_fail = True
+
+primop Int64QuotRemOp "quotRemInt64#" GenPrimOp Int64# -> Int64# -> (# Int64#, Int64# #)
+  with
+    can_fail = True
+
+primop Int64EqOp "eqInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64GeOp "geInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64GtOp "gtInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64LeOp "leInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64LtOp "ltInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64NeOp "neInt64#" Compare Int64# -> Int64# -> Int#
+
+------------------------------------------------------------------------
+section "Word64#"
+        {Operations on 64-bit unsigned integers.}
+------------------------------------------------------------------------
+
+primtype Word64#
+
+primop Word64Extend "extendWord64#" GenPrimOp Word64# -> Word#
+primop Word64Narrow "narrowWord64#" GenPrimOp Word# -> Word64#
+
+primop Word64NotOp "notWord64#" Monadic Word64# -> Word64#
+
+primop Word64AddOp "plusWord64#" Dyadic Word64# -> Word64# -> Word64#
+  with
+    commutable = True
+
+primop Word64SubOp "subWord64#" Dyadic Word64# -> Word64# -> Word64#
+
+primop Word64MulOp "timesWord64#" Dyadic Word64# -> Word64# -> Word64#
+  with
+    commutable = True
+
+primop Word64QuotOp "quotWord64#" Dyadic Word64# -> Word64# -> Word64#
+  with
+    can_fail = True
+
+primop Word64RemOp "remWord64#" Dyadic Word64# -> Word64# -> Word64#
+  with
+    can_fail = True
+
+primop Word64QuotRemOp "quotRemWord64#" GenPrimOp Word64# -> Word64# -> (# Word64#, Word64# #)
+  with
+    can_fail = True
+
+primop Word64EqOp "eqWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64GeOp "geWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64GtOp "gtWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64LeOp "leWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64LtOp "ltWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64NeOp "neWord64#" Compare Word64# -> Word64# -> Int#
+
 ------------------------------------------------------------------------
 section "Word#"
         {Operations on native-sized unsigned words (30+ bits).}

compiler/typecheck/TcGenDeriv.hs

@@ -1452,16 +1452,19 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
     eqInt8_RDR  , ltInt8_RDR  , geInt8_RDR  , gtInt8_RDR  , leInt8_RDR  ,
     eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,
     eqInt32_RDR , ltInt32_RDR , geInt32_RDR , gtInt32_RDR , leInt32_RDR ,
+    eqInt64_RDR , ltInt64_RDR , geInt64_RDR , gtInt64_RDR , leInt64_RDR ,
     eqWord_RDR  , ltWord_RDR  , geWord_RDR  , gtWord_RDR  , leWord_RDR  ,
     eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,
     eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,
     eqWord32_RDR, ltWord32_RDR, geWord32_RDR, gtWord32_RDR, leWord32_RDR,
+    eqWord64_RDR, ltWord64_RDR, geWord64_RDR, gtWord64_RDR, leWord64_RDR,
     eqAddr_RDR  , ltAddr_RDR  , geAddr_RDR  , gtAddr_RDR  , leAddr_RDR  ,
     eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
     eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
     extendWord8_RDR, extendInt8_RDR,
     extendWord16_RDR, extendInt16_RDR,
-    extendWord32_RDR, extendInt32_RDR :: RdrName
+    extendWord32_RDR, extendInt32_RDR,
+    extendWord64_RDR, extendInt64_RDR :: RdrName
 gfoldl_RDR     = varQual_RDR  gENERICS (fsLit "gfoldl")
 gunfold_RDR    = varQual_RDR  gENERICS (fsLit "gunfold")
 toConstr_RDR   = varQual_RDR  gENERICS (fsLit "toConstr")
@@ -1508,6 +1511,12 @@ leInt32_RDR    = varQual_RDR  gHC_PRIM (fsLit "leInt32#")
 gtInt32_RDR    = varQual_RDR  gHC_PRIM (fsLit "gtInt32#" )
 geInt32_RDR    = varQual_RDR  gHC_PRIM (fsLit "geInt32#")
 
+eqInt64_RDR    = varQual_RDR  gHC_PRIM (fsLit "eqInt64#")
+ltInt64_RDR    = varQual_RDR  gHC_PRIM (fsLit "ltInt64#" )
+leInt64_RDR    = varQual_RDR  gHC_PRIM (fsLit "leInt64#")
+gtInt64_RDR    = varQual_RDR  gHC_PRIM (fsLit "gtInt64#" )
+geInt64_RDR    = varQual_RDR  gHC_PRIM (fsLit "geInt64#")
+
 eqWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "eqWord#")
 ltWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "ltWord#")
 leWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "leWord#")
@@ -1532,6 +1541,12 @@ leWord32_RDR   = varQual_RDR  gHC_PRIM (fsLit "leWord32#")
 gtWord32_RDR   = varQual_RDR  gHC_PRIM (fsLit "gtWord32#" )
 geWord32_RDR   = varQual_RDR  gHC_PRIM (fsLit "geWord32#")
 
+eqWord64_RDR   = varQual_RDR  gHC_PRIM (fsLit "eqWord64#")
+ltWord64_RDR   = varQual_RDR  gHC_PRIM (fsLit "ltWord64#" )
+leWord64_RDR   = varQual_RDR  gHC_PRIM (fsLit "leWord64#")
+gtWord64_RDR   = varQual_RDR  gHC_PRIM (fsLit "gtWord64#" )
+geWord64_RDR   = varQual_RDR  gHC_PRIM (fsLit "geWord64#")
+
 eqAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "eqAddr#")
 ltAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "ltAddr#")
 leAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "leAddr#")
@@ -1559,6 +1574,9 @@ extendInt16_RDR  = varQual_RDR  gHC_PRIM (fsLit "extendInt16#")
 extendWord32_RDR = varQual_RDR  gHC_PRIM (fsLit "extendWord32#")
 extendInt32_RDR  = varQual_RDR  gHC_PRIM (fsLit "extendInt32#")
 
+extendWord64_RDR = varQual_RDR  gHC_PRIM (fsLit "extendWord64#")
+extendInt64_RDR  = varQual_RDR  gHC_PRIM (fsLit "extendInt64#")
+
 {-
 ************************************************************************
 *                                                                      *
@@ -2024,10 +2042,12 @@ ordOpTbl
     ,(int8PrimTy  , (ltInt8_RDR  , leInt8_RDR  , eqInt8_RDR  , geInt8_RDR  , gtInt8_RDR   ))
     ,(int16PrimTy , (ltInt16_RDR , leInt16_RDR , eqInt16_RDR , geInt16_RDR , gtInt16_RDR   ))
     ,(int32PrimTy , (ltInt32_RDR , leInt32_RDR , eqInt32_RDR , geInt32_RDR , gtInt32_RDR   ))
+    ,(int64PrimTy , (ltInt64_RDR , leInt64_RDR , eqInt64_RDR , geInt64_RDR , gtInt64_RDR   ))
     ,(wordPrimTy  , (ltWord_RDR  , leWord_RDR  , eqWord_RDR  , geWord_RDR  , gtWord_RDR  ))
     ,(word8PrimTy , (ltWord8_RDR , leWord8_RDR , eqWord8_RDR , geWord8_RDR , gtWord8_RDR   ))
     ,(word16PrimTy, (ltWord16_RDR, leWord16_RDR, eqWord16_RDR, geWord16_RDR, gtWord16_RDR  ))
     ,(word32PrimTy, (ltWord32_RDR, leWord32_RDR, eqWord32_RDR, geWord32_RDR, gtWord32_RDR  ))
+    ,(word64PrimTy, (ltWord64_RDR, leWord64_RDR, eqWord64_RDR, geWord64_RDR, gtWord64_RDR  ))
     ,(addrPrimTy  , (ltAddr_RDR  , leAddr_RDR  , eqAddr_RDR  , geAddr_RDR  , gtAddr_RDR  ))
     ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR , eqFloat_RDR , geFloat_RDR , gtFloat_RDR ))
     ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR, eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ]
@@ -2060,6 +2080,12 @@ boxConTbl =
     , (word32PrimTy,
         nlHsApp (nlHsVar $ getRdrName wordDataCon)
         .  nlHsApp (nlHsVar extendWord32_RDR))
+    , (int64PrimTy,
+        nlHsApp (nlHsVar $ getRdrName intDataCon)
+        . nlHsApp (nlHsVar extendInt64_RDR))
+    , (word64PrimTy,
+        nlHsApp (nlHsVar $ getRdrName wordDataCon)
+        .  nlHsApp (nlHsVar extendWord64_RDR))
 
     ]
 
@@ -2078,6 +2104,8 @@ postfixModTbl
     ,(word16PrimTy, "##")
     ,(int32PrimTy, "#")
     ,(word32PrimTy, "##")
+    ,(int64PrimTy, "#")
+    ,(word64PrimTy, "##")
 
     ]
 
@@ -2089,6 +2117,9 @@ primConvTbl =
     , (word16PrimTy, "narrowWord16#")
     , (int32PrimTy, "narrowInt32#")
     , (word32PrimTy, "narrowWord32#")
+    , (int64PrimTy, "narrowInt64#")
+    , (word64PrimTy, "narrowWord64#")
+
     ]
 
 litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]

testsuite/tests/ffi/should_run/PrimFFIInt64.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module Main where
+
+import GHC.Exts
+
+foreign import ccall "add_all_int64"
+    add_all_int64
+        :: Int64# -> Int64# -> Int64# -> Int64# -> Int64#
+        -> Int64# -> Int64# -> Int64# -> Int64# -> Int64#
+        -> Int64#
+
+main :: IO ()
+main = do
+    let a = narrowInt64# 0#
+        b = narrowInt64# 1#
+        c = narrowInt64# 2#
+        d = narrowInt64# 3#
+        e = narrowInt64# 4#
+        f = narrowInt64# 5#
+        g = narrowInt64# 6#
+        h = narrowInt64# 7#
+        i = narrowInt64# 8#
+        j = narrowInt64# 9#
+        x = I# (extendInt64# (add_all_int64 a b c d e f g h i j))
+    print x

testsuite/tests/ffi/should_run/PrimFFIInt64.stdout

@@ -0,0 +1 @@
+45

testsuite/tests/ffi/should_run/PrimFFIInt64_c.c

@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int64_t add_all_int64(
+        int64_t a, int64_t b, int64_t c, int64_t d, int64_t e,
+        int64_t f, int64_t g, int64_t h, int64_t i, int64_t j) {
+    return a + b + c + d + e + f + g + h + i + j;
+}

testsuite/tests/ffi/should_run/PrimFFIWord64.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module Main where
+
+import GHC.Exts
+
+foreign import ccall "add_all_word64"
+    add_all_word64
+        :: Word64# -> Word64# -> Word64# -> Word64# -> Word64#
+        -> Word64# -> Word64# -> Word64# -> Word64# -> Word64#
+        -> Word64#
+
+main :: IO ()
+main = do
+    let a = narrowWord64# 0##
+        b = narrowWord64# 1##
+        c = narrowWord64# 2##
+        d = narrowWord64# 3##
+        e = narrowWord64# 4##
+        f = narrowWord64# 5##
+        g = narrowWord64# 6##
+        h = narrowWord64# 7##
+        i = narrowWord64# 8##
+        j = narrowWord64# 9##
+        x = W# (extendWord64# (add_all_word64 a b c d e f g h i j))
+    print x

testsuite/tests/ffi/should_run/PrimFFIWord64.stdout

@@ -0,0 +1 @@
+45

testsuite/tests/ffi/should_run/PrimFFIWord64_c.c

@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+uint64_t add_all_word64(
+        uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e,
+        uint64_t f, uint64_t g, uint64_t h, uint64_t i, uint64_t j) {
+    return a + b + c + d + e + f + g + h + i + j;
+}

testsuite/tests/ffi/should_run/all.T

@@ -199,4 +199,8 @@ test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.
 
 test('PrimFFIInt32', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt32_c.c'])
 
-test('PrimFFIWord32', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord32_c.c'])
+test('PrimFFIWord32', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord32_c.c'])
+
+test('PrimFFIInt64', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt64_c.c'])
+
+test('PrimFFIWord64', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord64_c.c'])