Commit c81996a4 authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot
Browse files

GHC.Utils.Binary: Eliminate allocating withForeignPtr uses

parent a699389f
......@@ -6,6 +6,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
#if MIN_VERSION_base(4,16,0)
......@@ -96,10 +97,16 @@ import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import GHC.Real ( Ratio(..) )
#if MIN_VERSION_base(4,15,0)
import GHC.ForeignPtr ( unsafeWithForeignPtr )
#endif
type BinArray = ForeignPtr Word8
#if !MIN_VERSION_base(4,15,0)
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = withForeignPtr
#endif
---------------------------------------------------------------
-- BinData
......@@ -114,14 +121,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)
......@@ -229,7 +236,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
......@@ -239,7 +246,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
......@@ -283,7 +290,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
......@@ -305,7 +312,9 @@ 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 <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix)
-- This is safe WRT #17760 as we we guarantee that the above line doesn't
-- diverge
writeFastMutInt ix_r (ix + size)
return w
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment