diff --git a/Control/Monad/Primitive.hs b/Control/Monad/Primitive.hs --- a/Control/Monad/Primitive.hs +++ b/Control/Monad/Primitive.hs @@ -31,7 +31,9 @@ import GHC.ST ( ST(..) ) import Control.Monad.Trans.Class (lift) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid) +#endif import Control.Monad.Trans.Identity ( IdentityT) import Control.Monad.Trans.List ( ListT ) diff --git a/Data/Primitive/Internal/Operations.hs b/Data/Primitive/Internal/Operations.hs --- a/Data/Primitive/Internal/Operations.hs +++ b/Data/Primitive/Internal/Operations.hs @@ -27,63 +27,64 @@ ) where import Data.Primitive.MachDeps (Word64_#, Int64_#) +import Foreign.C.Types import GHC.Prim foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" - setWord8Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO () + setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" - setWord16Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO () + setWord16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" - setWord32Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO () + setWord32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" - setWord64Array# :: MutableByteArray# s -> Int# -> Int# -> Word64_# -> IO () + setWord64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" - setWordArray# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO () + setWordArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" - setInt8Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO () + setInt8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" - setInt16Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO () + setInt16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" - setInt32Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO () + setInt32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" - setInt64Array# :: MutableByteArray# s -> Int# -> Int# -> Int64_# -> IO () + setInt64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" - setIntArray# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO () + setIntArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" - setAddrArray# :: MutableByteArray# s -> Int# -> Int# -> Addr# -> IO () + setAddrArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float" - setFloatArray# :: MutableByteArray# s -> Int# -> Int# -> Float# -> IO () + setFloatArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Float# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double" - setDoubleArray# :: MutableByteArray# s -> Int# -> Int# -> Double# -> IO () + setDoubleArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Double# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" - setWideCharArray# :: MutableByteArray# s -> Int# -> Int# -> Char# -> IO () + setWideCharArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Char# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" - setWord8OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO () + setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" - setWord16OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO () + setWord16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" - setWord32OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO () + setWord32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" - setWord64OffAddr# :: Addr# -> Int# -> Int# -> Word64_# -> IO () + setWord64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" - setWordOffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO () + setWordOffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" - setInt8OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO () + setInt8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" - setInt16OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO () + setInt16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" - setInt32OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO () + setInt32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" - setInt64OffAddr# :: Addr# -> Int# -> Int# -> Int64_# -> IO () + setInt64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" - setIntOffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO () + setIntOffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" - setAddrOffAddr# :: Addr# -> Int# -> Int# -> Addr# -> IO () + setAddrOffAddr# :: Addr# -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float" - setFloatOffAddr# :: Addr# -> Int# -> Int# -> Float# -> IO () + setFloatOffAddr# :: Addr# -> CPtrdiff -> CSize -> Float# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double" - setDoubleOffAddr# :: Addr# -> Int# -> Int# -> Double# -> IO () + setDoubleOffAddr# :: Addr# -> CPtrdiff -> CSize -> Double# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" - setWideCharOffAddr# :: Addr# -> Int# -> Int# -> Char# -> IO () + setWideCharOffAddr# :: Addr# -> CPtrdiff -> CSize -> Char# -> IO () diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs --- a/Data/Primitive/Types.hs +++ b/Data/Primitive/Types.hs @@ -113,7 +113,10 @@ { (# s1#, x# #) -> (# s1#, ctr x# #) } \ ; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s# \ ; setByteArray# arr# i# n# (ctr x#) s# \ - = case unsafeCoerce# (internal (set_arr arr# i# n# x#)) s# of \ + = let { i = fromIntegral (I# i#) \ + ; n = fromIntegral (I# n#) \ + } in \ + case unsafeCoerce# (internal (set_arr arr# i n x#)) s# of \ { (# s1#, _ #) -> s1# } \ \ ; indexOffAddr# addr# i# = ctr (idx_addr addr# i#) \ @@ -121,7 +124,10 @@ { (# s1#, x# #) -> (# s1#, ctr x# #) } \ ; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s# \ ; setOffAddr# addr# i# n# (ctr x#) s# \ - = case unsafeCoerce# (internal (set_addr addr# i# n# x#)) s# of \ + = let { i = fromIntegral (I# i#) \ + ; n = fromIntegral (I# n#) \ + } in \ + case unsafeCoerce# (internal (set_addr addr# i n x#)) s# of \ { (# s1#, _ #) -> s1# } \ ; {-# INLINE sizeOf# #-} \ ; {-# INLINE alignment# #-} \ diff --git a/cbits/primitive-memops.c b/cbits/primitive-memops.c --- a/cbits/primitive-memops.c +++ b/cbits/primitive-memops.c @@ -1,18 +1,18 @@ #include #include "primitive-memops.h" -void hsprimitive_memcpy( void *dst, int doff, void *src, int soff, size_t len ) +void hsprimitive_memcpy( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ) { memcpy( (char *)dst + doff, (char *)src + soff, len ); } -void hsprimitive_memmove( void *dst, int doff, void *src, int soff, size_t len ) +void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ) { memmove( (char *)dst + doff, (char *)src + soff, len ); } #define MEMSET(TYPE, ATYPE) \ -void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, int off, int n, ATYPE x) \ +void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, ptrdiff_t off, size_t n, ATYPE x) \ { \ p += off; \ if (x == 0) \ @@ -35,7 +35,7 @@ } \ } -void hsprimitive_memset_Word8 (HsWord8 *p, int off, int n, HsWord x) +void hsprimitive_memset_Word8 (HsWord8 *p, ptrdiff_t off, size_t n, HsWord x) { memset( (char *)(p+off), x, n ); } diff --git a/cbits/primitive-memops.h b/cbits/primitive-memops.h --- a/cbits/primitive-memops.h +++ b/cbits/primitive-memops.h @@ -2,20 +2,21 @@ #define haskell_primitive_memops_h #include +#include #include -void hsprimitive_memcpy( void *dst, int doff, void *src, int soff, size_t len ); -void hsprimitive_memmove( void *dst, int doff, void *src, int soff, size_t len ); +void hsprimitive_memcpy( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); +void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); -void hsprimitive_memset_Word8 (HsWord8 *, int, int, HsWord); -void hsprimitive_memset_Word16 (HsWord16 *, int, int, HsWord); -void hsprimitive_memset_Word32 (HsWord32 *, int, int, HsWord); -void hsprimitive_memset_Word64 (HsWord64 *, int, int, HsWord64); -void hsprimitive_memset_Word (HsWord *, int, int, HsWord); -void hsprimitive_memset_Ptr (HsPtr *, int, int, HsPtr); -void hsprimitive_memset_Float (HsFloat *, int, int, HsFloat); -void hsprimitive_memset_Double (HsDouble *, int, int, HsDouble); -void hsprimitive_memset_Char (HsChar *, int, int, HsChar); +void hsprimitive_memset_Word8 (HsWord8 *, ptrdiff_t, size_t, HsWord); +void hsprimitive_memset_Word16 (HsWord16 *, ptrdiff_t, size_t, HsWord); +void hsprimitive_memset_Word32 (HsWord32 *, ptrdiff_t, size_t, HsWord); +void hsprimitive_memset_Word64 (HsWord64 *, ptrdiff_t, size_t, HsWord64); +void hsprimitive_memset_Word (HsWord *, ptrdiff_t, size_t, HsWord); +void hsprimitive_memset_Ptr (HsPtr *, ptrdiff_t, size_t, HsPtr); +void hsprimitive_memset_Float (HsFloat *, ptrdiff_t, size_t, HsFloat); +void hsprimitive_memset_Double (HsDouble *, ptrdiff_t, size_t, HsDouble); +void hsprimitive_memset_Char (HsChar *, ptrdiff_t, size_t, HsChar); #endif diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +## Changes in version 0.6.1.0 + + * Use more appropriate types in internal memset functions, which prevents + overflows/segfaults on 64-bit systems. + + * Fixed a warning on GHC 7.10 + + * Worked around a -dcore-lint bug in GHC 7.6/7.7 + ## Changes in version 0.6 * Split PrimMonad into two classes to allow automatic lifting of primitive diff --git a/primitive.cabal b/primitive.cabal --- a/primitive.cabal +++ b/primitive.cabal @@ -1,5 +1,5 @@ Name: primitive -Version: 0.6 +Version: 0.6.1.0 License: BSD3 License-File: LICENSE