diff options
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 95 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 50 | ||||
-rw-r--r-- | compiler/GHC/StgToJS/Prim.hs | 4 | ||||
-rw-r--r-- | libraries/base/Data/Array/Byte.hs | 4 | ||||
-rw-r--r-- | libraries/base/Foreign/Marshal/Utils.hs | 35 | ||||
-rw-r--r-- | libraries/ghc-prim/changelog.md | 7 |
6 files changed, 155 insertions, 40 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index e99e5dc3a3..c6f205c6a5 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -1890,13 +1890,14 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp primop CopyByteArrayOp "copyByteArray#" GenPrimOp ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {@'copyByteArray#' src src_ofs dst dst_ofs n@ copies the range - starting at offset @src_ofs@ of length @n@ from the - 'ByteArray#' @src@ to the 'MutableByteArray#' @dst@ - starting at offset @dst_ofs@. Both arrays must fully contain - the specified ranges, but this is not checked. The two arrays must - not be the same array in different states, but this is not checked - either.} + { @'copyByteArray#' src src_ofs dst dst_ofs len@ copies the range + starting at offset @src_ofs@ of length @len@ from the + 'ByteArray#' @src@ to the 'MutableByteArray#' @dst@ + starting at offset @dst_ofs@. Both arrays must fully contain + the specified ranges, but this is not checked. The two arrays must + not be the same array in different states, but this is not checked + either. + } with has_side_effects = True code_size = { primOpCodeSizeForeignCall + 4} @@ -1904,10 +1905,30 @@ primop CopyByteArrayOp "copyByteArray#" GenPrimOp primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableByteArray\# to the specified region in the second MutableByteArray\#. - Both arrays must fully contain the specified ranges, but this is not checked. The regions are - allowed to overlap, although this is only possible when the same array is provided - as both the source and the destination.} + { @'copyMutableByteArray#' src src_ofs dst dst_ofs len@ copies the + range starting at offset @src_ofs@ of length @len@ from the + 'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@ + starting at offset @dst_ofs@. Both arrays must fully contain the + specified ranges, but this is not checked. The regions are + allowed to overlap, although this is only possible when the same + array is provided as both the source and the destination. + } + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4 } + can_fail = True + +primop CopyMutableByteArrayNonOverlappingOp "copyMutableByteArrayNonOverlapping#" GenPrimOp + MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + { @'copyMutableByteArrayNonOverlapping#' src src_ofs dst dst_ofs len@ + copies the range starting at offset @src_ofs@ of length @len@ from + the 'MutableByteArray#' @src@ to the 'MutableByteArray#' @dst@ + starting at offset @dst_ofs@. Both arrays must fully contain the + specified ranges, but this is not checked. The regions are /not/ + allowed to overlap, but this is also not checked. + + @since 0.11.0 + } with has_side_effects = True code_size = { primOpCodeSizeForeignCall + 4 } @@ -1922,7 +1943,7 @@ primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp either.} with has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} + code_size = { primOpCodeSizeForeignCall + 4 } can_fail = True primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp @@ -1934,7 +1955,7 @@ primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp pinned), but this is not checked either.} with has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} + code_size = { primOpCodeSizeForeignCall + 4 } can_fail = True primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp @@ -1946,7 +1967,38 @@ primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp but this is not checked either.} with has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} + code_size = { primOpCodeSizeForeignCall + 4 } + can_fail = True + +primop CopyAddrToAddrOp "copyAddrToAddr#" GenPrimOp + Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld + { @'copyAddrToAddr#' src dest len@ copies @len@ bytes + from @src@ to @dest@. These two memory ranges are allowed to overlap. + + Analogous to the standard C function @memmove@, but with a different + argument order. + + @since 0.11.0 + } + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop CopyAddrToAddrNonOverlappingOp "copyAddrToAddrNonOverlapping#" GenPrimOp + Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld + { @'copyAddrToAddrNonOverlapping#' src dest len@ copies @len@ bytes + from @src@ to @dest@. As the name suggests, these two memory ranges + /must not overlap/, although this pre-condition is not checked. + + Analogous to the standard C function @memcpy@, but with a different + argument order. + + @since 0.11.0 + } + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall } can_fail = True primop SetByteArrayOp "setByteArray#" GenPrimOp @@ -1958,6 +2010,21 @@ primop SetByteArrayOp "setByteArray#" GenPrimOp code_size = { primOpCodeSizeForeignCall + 4 } can_fail = True +primop SetAddrRangeOp "setAddrRange#" GenPrimOp + Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld + { @'setAddrRange#' dest len c@ sets all of the bytes in + @[dest, dest+len)@ to the value @c@. + + Analogous to the standard C function @memset@, but with a different + argument order. + + @since 0.11.0 + } + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall } + can_fail = True + -- Atomic operations primop AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index f7afeb71a9..1837d9ac37 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -715,14 +715,22 @@ emitPrimOp cfg primop = doCopyByteArrayOp src src_off dst dst_off n CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] -> doCopyMutableByteArrayOp src src_off dst dst_off n + CopyMutableByteArrayNonOverlappingOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] -> + doCopyMutableByteArrayNonOverlappingOp src src_off dst dst_off n CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] -> doCopyByteArrayToAddrOp src src_off dst n CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] -> doCopyMutableByteArrayToAddrOp src src_off dst n CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> opIntoRegs $ \[] -> doCopyAddrToByteArrayOp src dst dst_off n + CopyAddrToAddrOp -> \[src,dst,n] -> opIntoRegs $ \[] -> + doCopyAddrToAddrOp src dst n + CopyAddrToAddrNonOverlappingOp -> \[src,dst,n] -> opIntoRegs $ \[] -> + doCopyAddrToAddrNonOverlappingOp src dst n SetByteArrayOp -> \[ba,off,len,c] -> opIntoRegs $ \[] -> doSetByteArrayOp ba off len c + SetAddrRangeOp -> \[dst,len,c] -> opIntoRegs $ \[] -> + doSetAddrRangeOp dst len c -- Comparing byte arrays CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> opIntoRegs $ \[res] -> @@ -2518,6 +2526,7 @@ doCopyByteArrayOp = emitCopyByteArray copy where -- Copy data (we assume the arrays aren't overlapping since -- they're of different types) + -- TODO: Make -fcheck-prim-bounds check that the arrays are distinct copy _src _dst dst_p src_p bytes align = emitMemcpyCall dst_p src_p bytes align @@ -2540,6 +2549,20 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy (getCode $ emitMemcpyCall dst_p src_p bytes align) emit =<< mkCmmIfThenElse (cmmEqWord platform src dst) moveCall cpyCall +-- | Takes a source 'MutableByteArray#', an offset in the source +-- array, a destination 'MutableByteArray#', an offset into the +-- destination array, and the number of bytes to copy. Copies the +-- given number of bytes from the source array to the destination +-- array. Assumes the two ranges are disjoint +doCopyMutableByteArrayNonOverlappingOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr + -> FCode () +doCopyMutableByteArrayNonOverlappingOp = emitCopyByteArray copy + where + copy _src _dst dst_p src_p bytes align = do + -- TODO: Make -fcheck-prim-bounds verify no overlap here + emitMemcpyCall dst_p src_p bytes align + + emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()) -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr @@ -2596,6 +2619,23 @@ doCopyAddrToByteArrayOp src_p dst dst_off bytes = do dst_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform dst (arrWordsHdrSize profile)) dst_off emitMemcpyCall dst_p src_p bytes (mkAlignment 1) +-- | Takes a source 'Addr#', a destination 'Addr#', and the number of +-- bytes to copy. Copies the given number of bytes from the source +-- memory region to the destination array. +doCopyAddrToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode () +doCopyAddrToAddrOp src_p dst_p bytes = do + -- Use memmove; the ranges may overlap + emitMemmoveCall dst_p src_p bytes (mkAlignment 1) + +-- | Takes a source 'Addr#', a destination 'Addr#', and the number of +-- bytes to copy. Copies the given number of bytes from the source +-- memory region to the destination region. The regions may not overlap. +doCopyAddrToAddrNonOverlappingOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode () +doCopyAddrToAddrNonOverlappingOp src_p dst_p bytes = do + -- Use memcpy; the ranges may not overlap + -- TODO: Make -fcheck-prim-bounds verify no overlap here + emitMemcpyCall dst_p src_p bytes (mkAlignment 1) + ifNonZero :: CmmExpr -> FCode () -> FCode () ifNonZero e it = do platform <- getPlatform @@ -2608,7 +2648,7 @@ ifNonZero e it = do -- | Takes a 'MutableByteArray#', an offset into the array, a length, -- and a byte, and sets each of the selected bytes in the array to the --- character. +-- given byte. doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode () doSetByteArrayOp ba off len c = do @@ -2625,6 +2665,14 @@ doSetByteArrayOp ba off len c = do p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform ba (arrWordsHdrSize profile)) off emitMemsetCall p c len align +-- | Takes an 'Addr#', a length, and a byte, and sets each of the +-- selected bytes in memory to the given byte. +doSetAddrRangeOp :: CmmExpr -> CmmExpr -> CmmExpr + -> FCode () +doSetAddrRangeOp dst len c = do + emitMemsetCall dst c len (mkAlignment 1) + + -- ---------------------------------------------------------------------------- -- Allocating arrays diff --git a/compiler/GHC/StgToJS/Prim.hs b/compiler/GHC/StgToJS/Prim.hs index 5c81744f2a..188d6167fa 100644 --- a/compiler/GHC/StgToJS/Prim.hs +++ b/compiler/GHC/StgToJS/Prim.hs @@ -717,15 +717,19 @@ genPrim prof bound ty op = case op of . boundsChecked bound a2 (Add o2 (Sub n 1)) $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs SetByteArrayOp -> \[] [a,o,n,v] -> PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] + SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v diff --git a/libraries/base/Data/Array/Byte.hs b/libraries/base/Data/Array/Byte.hs index 918e20bae8..99a7b0a36e 100644 --- a/libraries/base/Data/Array/Byte.hs +++ b/libraries/base/Data/Array/Byte.hs @@ -134,7 +134,7 @@ unsafeCopyByteArray (MutableByteArray dst#) (I# doff#) (ByteArray src#) (I# soff -- | Copy a slice from one mutable byte array to another -- or to the same mutable byte array. -- --- /Note:/ this function does not do bounds checking. +-- /Note:/ this function does not do bounds or overlap checking. unsafeCopyMutableByteArray :: MutableByteArray s -- ^ destination array -> Int -- ^ offset into destination array @@ -144,7 +144,7 @@ unsafeCopyMutableByteArray -> ST s () {-# INLINE unsafeCopyMutableByteArray #-} unsafeCopyMutableByteArray (MutableByteArray dst#) (I# doff#) (MutableByteArray src#) (I# soff#) (I# sz#) = - ST (\s# -> case copyMutableByteArray# src# soff# dst# doff# sz# s# of + ST (\s# -> case copyMutableByteArrayNonOverlapping# src# soff# dst# doff# sz# s# of s'# -> (# s'#, () #)) -- | @since 4.17.0.0 diff --git a/libraries/base/Foreign/Marshal/Utils.hs b/libraries/base/Foreign/Marshal/Utils.hs index d134788e62..7d6cdcc879 100644 --- a/libraries/base/Foreign/Marshal/Utils.hs +++ b/libraries/base/Foreign/Marshal/Utils.hs @@ -1,6 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Utils @@ -50,13 +53,11 @@ module Foreign.Marshal.Utils ( ) where import Data.Maybe -import Foreign.Ptr ( Ptr, nullPtr ) +import GHC.Ptr ( Ptr(..), nullPtr ) import Foreign.Storable ( Storable(poke) ) -import Foreign.C.Types ( CSize(..), CInt(..) ) import Foreign.Marshal.Alloc ( malloc, alloca ) -import Data.Word ( Word8 ) +import GHC.Word ( Word8(..) ) -import GHC.Real ( fromIntegral ) import GHC.Num import GHC.Base @@ -158,9 +159,8 @@ copyBytes -> Ptr a -- ^ Source -> Int -- ^ Size in bytes -> IO () -copyBytes dest src size = do - _ <- memcpy dest src (fromIntegral size) - return () +copyBytes = coerce $ \(Ptr dest#) (Ptr src#) (I# size#) s + -> (# copyAddrToAddrNonOverlapping# src# dest# size# s, () #) -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas /may/ overlap @@ -170,9 +170,8 @@ moveBytes -> Ptr a -- ^ Source -> Int -- ^ Size in bytes -> IO () -moveBytes dest src size = do - _ <- memmove dest src (fromIntegral size) - return () +moveBytes = coerce $ \(Ptr dest#) (Ptr src#) (I# size#) s + -> (# copyAddrToAddr# src# dest# size# s, () #) -- Filling up memory area with required values -- ------------------------------------------- @@ -180,16 +179,6 @@ moveBytes dest src size = do -- |Fill a given number of bytes in memory area with a byte value. -- -- @since 4.8.0.0 -fillBytes :: Ptr a -> Word8 -> Int -> IO () -fillBytes dest char size = do - _ <- memset dest (fromIntegral char) (fromIntegral size) - return () - --- auxiliary routines --- ------------------- - --- |Basic C routines needed for memory copying --- -foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a) -foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a) -foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a) +fillBytes :: Ptr a -> Word8 -> Int -> IO () +fillBytes = coerce $ \(Ptr dest#) (W8# byte#) (I# size#) s + -> (# setAddrRange# dest# size# (word2Int# (word8ToWord# byte#)) s, () #) diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index c78de3c5e2..221325c029 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -14,6 +14,13 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- Several new primops were added: + + - `copyMutableByteArrayNonOverlapping#` + - `copyAddrToAddr#` + - `copyAddrToAddrNonOverlapping#` + - `setAddrRange#` + ## 0.10.0 - Shipped with GHC 9.6.1 |