[Git][ghc/ghc][wip/no-fptr] 5 commits: GHC.Utils.Binary: Eliminate allocating withForeignPtr uses
Ben Gamari
gitlab at gitlab.haskell.org
Sun Nov 29 17:02:30 UTC 2020
Ben Gamari pushed to branch wip/no-fptr at Glasgow Haskell Compiler / GHC
Commits:
a20e6c8c by Ben Gamari at 2020-11-27T14:33:51-05:00
GHC.Utils.Binary: Eliminate allocating withForeignPtr uses
- - - - -
6ca6b8e7 by Ben Gamari at 2020-11-27T14:33:51-05:00
base: Eliminate allocating withForeignPtrs from GHC.Event.Array
- - - - -
7d79edbd by Ben Gamari at 2020-11-28T13:12:29-05:00
base: Use unsafeWithForeignPtr in GHC.IO.Buffer
- - - - -
fa6edd4d by Ben Gamari at 2020-11-28T13:12:29-05:00
GHC.Event.Array: Use unsafeWithForeignPtr
- - - - -
f40b662b by Ben Gamari at 2020-11-28T13:12:43-05:00
Bump bytestring submodule
Teach it to use unsafeWithForeignPtr where appropriate.
- - - - -
4 changed files:
- compiler/GHC/Utils/Binary.hs
- libraries/base/GHC/Event/Array.hs
- libraries/base/GHC/IO/Buffer.hs
- libraries/bytestring
Changes:
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
-- We always optimise this, otherwise performance of a non-optimised
@@ -84,6 +85,7 @@ import Data.Array
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
+import GHC.ForeignPtr
import Data.IORef
import Data.Char ( ord, chr )
import Data.Time
@@ -96,7 +98,10 @@ import GHC.Real ( Ratio(..) )
type BinArray = ForeignPtr Word8
-
+#if !MIN_VERSION_base(4,15,0)
+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+unsafeWithForeignPtr = withForeignPtr
+#endif
---------------------------------------------------------------
-- BinData
@@ -111,14 +116,14 @@ instance Binary BinData where
put_ bh (BinData sz dat) = do
put_ bh sz
putPrim bh sz $ \dest ->
- withForeignPtr dat $ \orig ->
+ unsafeWithForeignPtr dat $ \orig ->
copyBytes dest orig sz
--
get bh = do
sz <- get bh
dat <- mallocForeignPtrBytes sz
getPrim bh sz $ \orig ->
- withForeignPtr dat $ \dest ->
+ unsafeWithForeignPtr dat $ \dest ->
copyBytes dest orig sz
return (BinData sz dat)
@@ -226,7 +231,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do
h <- openBinaryFile fn WriteMode
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
- withForeignPtr arr $ \p -> hPutBuf h p ix
+ unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix
hClose h
readBinMem :: FilePath -> IO BinHandle
@@ -236,7 +241,7 @@ readBinMem filename = do
filesize' <- hFileSize h
let filesize = fromIntegral filesize'
arr <- mallocForeignPtrBytes filesize
- count <- withForeignPtr arr $ \p -> hGetBuf h p filesize
+ count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize
when (count /= filesize) $
error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
hClose h
@@ -280,7 +285,7 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do
when (ix + size > sz) $
expandBin h (ix + size)
arr <- readIORef arr_r
- withForeignPtr arr $ \op -> f (op `plusPtr` ix)
+ unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix)
writeFastMutInt ix_r (ix + size)
-- -- | Similar to putPrim but advances the index by the actual number of
@@ -302,7 +307,10 @@ getPrim (BinMem _ ix_r sz_r arr_r) size f = do
when (ix + size > sz) $
ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
arr <- readIORef arr_r
- w <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)
+ w <- f (unsafeForeignPtrToPtr arr `plusPtr` ix)
+ touchForeignPtr arr
+ -- This is safe WRT #17760 as we we guarantee that the above line doesn't
+ -- diverge
writeFastMutInt ix_r (ix + size)
return w
=====================================
libraries/base/GHC/Event/Array.hs
=====================================
@@ -33,7 +33,7 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Base hiding (empty)
-import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)
+import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr)
import GHC.Num (Num(..))
import GHC.Real (fromIntegral)
import GHC.Show (show)
@@ -78,9 +78,9 @@ reallocArray p newSize oldSize = reallocHack undefined p
reallocHack dummy src = do
let size = sizeOf dummy
dst <- mallocPlainForeignPtrBytes (newSize * size)
- withForeignPtr src $ \s ->
+ unsafeWithForeignPtr src $ \s ->
when (s /= nullPtr && oldSize > 0) .
- withForeignPtr dst $ \d -> do
+ unsafeWithForeignPtr dst $ \d -> do
_ <- memcpy d s (fromIntegral (oldSize * size))
return ()
return dst
@@ -99,8 +99,8 @@ duplicate a = dupHack undefined a
dupHack dummy (Array ref) = do
AC es len cap <- readIORef ref
ary <- allocArray cap
- withForeignPtr ary $ \dest ->
- withForeignPtr es $ \src -> do
+ unsafeWithForeignPtr ary $ \dest ->
+ unsafeWithForeignPtr es $ \src -> do
_ <- memcpy dest src (fromIntegral (len * sizeOf dummy))
return ()
Array `fmap` newIORef (AC ary len cap)
@@ -119,8 +119,8 @@ unsafeRead :: Storable a => Array a -> Int -> IO a
unsafeRead (Array ref) ix = do
AC es _ cap <- readIORef ref
CHECK_BOUNDS("unsafeRead",cap,ix)
- withForeignPtr es $ \p ->
- peekElemOff p ix
+ unsafeWithForeignPtr es $ \ptr -> peekElemOff ptr ix
+ -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge
unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()
unsafeWrite (Array ref) ix a = do
@@ -130,13 +130,15 @@ unsafeWrite (Array ref) ix a = do
unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()
unsafeWrite' (AC es _ cap) ix a =
CHECK_BOUNDS("unsafeWrite'",cap,ix)
- withForeignPtr es $ \p ->
- pokeElemOff p ix a
+ unsafeWithForeignPtr es $ \ptr -> pokeElemOff ptr ix a
+ -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge
+-- | Precondition: continuation must not diverge due to use of
+-- 'unsafeWithForeignPtr'.
unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int
unsafeLoad (Array ref) load = do
AC es _ cap <- readIORef ref
- len' <- withForeignPtr es $ \p -> load p cap
+ len' <- unsafeWithForeignPtr es $ \p -> load p cap
writeIORef ref (AC es len' cap)
return len'
@@ -146,7 +148,7 @@ unsafeCopyFromBuffer :: Storable a => Array a -> Ptr a -> Int -> IO ()
unsafeCopyFromBuffer (Array ref) sptr n =
readIORef ref >>= \(AC es _ cap) ->
CHECK_BOUNDS("unsafeCopyFromBuffer", cap, n)
- withForeignPtr es $ \pdest -> do
+ unsafeWithForeignPtr es $ \pdest -> do
let size = sizeOfPtr sptr undefined
_ <- memcpy pdest sptr (fromIntegral $ n * size)
writeIORef ref (AC es n cap)
@@ -198,7 +200,7 @@ forM_ ary g = forHack ary g undefined
AC es len _ <- readIORef ref
let size = sizeOf dummy
offset = len * size
- withForeignPtr es $ \p -> do
+ unsafeWithForeignPtr es $ \p -> do
let go n | n >= offset = return ()
| otherwise = do
f =<< peek (p `plusPtr` n)
@@ -269,8 +271,8 @@ copy' d dstart s sstart maxCount = copyHack d s undefined
then return dac
else do
AC dst dlen dcap <- ensureCapacity' dac (dstart + count)
- withForeignPtr dst $ \dptr ->
- withForeignPtr src $ \sptr -> do
+ unsafeWithForeignPtr dst $ \dptr ->
+ unsafeWithForeignPtr src $ \sptr -> do
_ <- memcpy (dptr `plusPtr` (dstart * size))
(sptr `plusPtr` (sstart * size))
(fromIntegral (count * size))
@@ -286,7 +288,7 @@ removeAt a i = removeHack a undefined
let size = sizeOf dummy
newLen = oldLen - 1
when (newLen > 0 && i < newLen) .
- withForeignPtr fp $ \ptr -> do
+ unsafeWithForeignPtr fp $ \ptr -> do
_ <- memmove (ptr `plusPtr` (size * i))
(ptr `plusPtr` (size * (i+1)))
(fromIntegral (size * (newLen-i)))
=====================================
libraries/base/GHC/IO/Buffer.hs
=====================================
@@ -73,6 +73,7 @@ import GHC.Show
import GHC.Real
import GHC.List
import GHC.ForeignPtr.Ops
+import GHC.ForeignPtr (unsafeWithForeignPtr)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Storable
@@ -118,17 +119,17 @@ type CharBufElem = Char
type RawCharBuffer = RawBuffer CharBufElem
peekCharBuf :: RawCharBuffer -> Int -> IO Char
-peekCharBuf arr ix = withForeignPtr arr $ \p -> do
+peekCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> do
(c,_) <- readCharBufPtr p ix
return c
{-# INLINE readCharBuf #-}
readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
-readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix
+readCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> readCharBufPtr p ix
{-# INLINE writeCharBuf #-}
writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
-writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c
+writeCharBuf arr ix c = unsafeWithForeignPtr arr $ \p -> writeCharBufPtr p ix c
{-# INLINE readCharBufPtr #-}
readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)
=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit e043aacfc4202a59ccae8b8c8cf0e1ad83a3f209
+Subproject commit 8d5d8bd463f10244e3754dd03e4bf020a0ea03e3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f4327d893252acf6a7e7d4914a8168b2f16944e...f40b662b9ea555bab6e9729f4165eaca7021d322
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f4327d893252acf6a7e7d4914a8168b2f16944e...f40b662b9ea555bab6e9729f4165eaca7021d322
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201129/b5b7b388/attachment-0001.html>
More information about the ghc-commits
mailing list