on master help sign in
Fix memory corruption issue in reallocAligned
commit81393974305523fad94171e09c5574b7a16aa240 authorHarendra Kumar <harendra@composewell.com> dateWed 6 Oct 2021, 11:16 (5 years ago) parent1953900
2 files changed+18−6
hie.yaml+2 src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+16−6
hie.yaml+2
@@ -34,6 +34,8 @@ cradle:
3434 component: "bench:Prelude.Serial"
3535 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs"
3636 component: "bench:Prelude.Serial"
37+ - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs"
38+ component: "bench:Prelude.Serial"
3739 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs"
3840 component: "bench:Prelude.Serial"
3941 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs"
src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+16−6
@@ -332,25 +332,32 @@ snoc arr@Array {..} x =
332332-- | Reallocate the array to the specified size in bytes. If the size is less
333333-- than the original array the array gets truncated.
334334{-# NOINLINE reallocAligned #-}
335−reallocAligned :: Int -> Int -> Array a -> IO (Array a)
336−reallocAligned alignSize newSize Array{..} = do
335+reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
336+reallocAligned elemSize alignSize newSize Array{..} = do
337337 assert (aEnd <= aBound) (return ())
338338 let oldStart = unsafeForeignPtrToPtr aStart
339− let size = aEnd `minusPtr` oldStart
339+ oldSize = aEnd `minusPtr` oldStart
340+ assert (oldSize `mod` elemSize == 0) (return ())
340341 newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize
341342 unsafeWithForeignPtr newPtr $ \pNew -> do
343+ let size = min oldSize newSize
344+ assert (size >= 0) (return ())
345+ assert (size `mod` elemSize == 0) (return ())
342346 memcpy (castPtr pNew) (castPtr oldStart) size
343347 touchForeignPtr aStart
344348 return $ Array
345349 { aStart = newPtr
346− , aEnd = pNew `plusPtr` size
350+ , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))
347351 , aBound = pNew `plusPtr` newSize
348352 }
349353
350354-- XXX can unaligned allocation be more efficient when alignment is not needed?
351355{-# INLINABLE realloc #-}
352356realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
353−realloc i arr = liftIO $ reallocAligned (alignment (undefined :: a)) i arr
357+realloc i arr =
358+ liftIO
359+ $ reallocAligned
360+ (sizeOf (undefined :: a)) (alignment (undefined :: a)) i arr
354361
355362-- | Remove the free space from an Array.
356363{-# INLINE shrinkToFit #-}
@@ -890,7 +897,10 @@ toArrayMinChunk alignSize elemCount =
890897 let p = unsafeForeignPtrToPtr start
891898 oldSize = end `minusPtr` p
892899 newSize = max (oldSize * 2) 1
893− arr1 <- liftIO $ reallocAligned alignSize newSize arr
900+ arr1 <-
901+ liftIO
902+ $ reallocAligned
903+ (sizeOf (undefined :: a)) alignSize newSize arr
894904 insertElem arr1 x
895905 step arr x = insertElem arr x
896906 extract = liftIO . shrinkToFit