8139397 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Fix memory corruption issue in reallocAligned

8139397Harendra Kumar5 years ago

hie.yaml+2

compare with master

unifiedsplit

@@ -34,6 +34,8 @@ cradle:

34 component: "bench:Prelude.Serial"

35 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs"

36 component: "bench:Prelude.Serial"

37+ - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs"

38+ component: "bench:Prelude.Serial"

37 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs"

39 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs"

38 component: "bench:Prelude.Serial"

40 component: "bench:Prelude.Serial"

39 - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs"

41 - 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 =

332-- | Reallocate the array to the specified size in bytes. If the size is less

333-- than the original array the array gets truncated.

334{-# NOINLINE reallocAligned #-}

335−reallocAligned :: Int -> Int -> Array a -> IO (Array a)

335+reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)

336−reallocAligned alignSize newSize Array{..} = do

336+reallocAligned elemSize alignSize newSize Array{..} = do

337 assert (aEnd <= aBound) (return ())

338 let oldStart = unsafeForeignPtrToPtr aStart

339− let size = aEnd `minusPtr` oldStart

339+ oldSize = aEnd `minusPtr` oldStart

340+ assert (oldSize `mod` elemSize == 0) (return ())

340 newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize

341 newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize

341 unsafeWithForeignPtr newPtr $ \pNew -> do

342 unsafeWithForeignPtr newPtr $ \pNew -> do

343+ let size = min oldSize newSize

344+ assert (size >= 0) (return ())

345+ assert (size `mod` elemSize == 0) (return ())

342 memcpy (castPtr pNew) (castPtr oldStart) size

346 memcpy (castPtr pNew) (castPtr oldStart) size

343 touchForeignPtr aStart

347 touchForeignPtr aStart

344 return $ Array

348 return $ Array

345 { aStart = newPtr

349 { aStart = newPtr

346− , aEnd = pNew `plusPtr` size

350+ , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))

347 , aBound = pNew `plusPtr` newSize

351 , aBound = pNew `plusPtr` newSize

348 }

352 }

349

353

350-- XXX can unaligned allocation be more efficient when alignment is not needed?

354-- XXX can unaligned allocation be more efficient when alignment is not needed?

351{-# INLINABLE realloc #-}

355{-# INLINABLE realloc #-}

352realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)

356realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)

357+realloc i arr =

358+ liftIO

359+ $ reallocAligned

353−realloc i arr = liftIO $ reallocAligned (alignment (undefined :: a)) i arr

360+ (sizeOf (undefined :: a)) (alignment (undefined :: a)) i arr

354

361

355-- | Remove the free space from an Array.

362-- | Remove the free space from an Array.

356{-# INLINE shrinkToFit #-}

363{-# INLINE shrinkToFit #-}

@@ -890,7 +897,10 @@ toArrayMinChunk alignSize elemCount =

890 let p = unsafeForeignPtrToPtr start

897 let p = unsafeForeignPtrToPtr start

891 oldSize = end `minusPtr` p

898 oldSize = end `minusPtr` p

892 newSize = max (oldSize * 2) 1

899 newSize = max (oldSize * 2) 1

900+ arr1 <-

901+ liftIO

893− arr1 <- liftIO $ reallocAligned alignSize newSize arr

902+ $ reallocAligned

903+ (sizeOf (undefined :: a)) alignSize newSize arr

894 insertElem arr1 x

904 insertElem arr1 x

895 step arr x = insertElem arr x

905 step arr x = insertElem arr x

896 extract = liftIO . shrinkToFit

906 extract = liftIO . shrinkToFit