a8df0ab · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Implemented both possible buffer allocators for testing.

a8df0abMartin Bailey12 years ago

warp/Network/Wai/Handler/Warp/Buffer.hs+15−7

compare with master

unifiedsplit

@@ -5,9 +5,9 @@ import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..))

5import Data.Word (Word8)

6import Data.IORef (IORef, newIORef, readIORef, writeIORef)

7import Data.ByteString (ByteString, empty, length)

8−import Data.ByteString.Internal (ByteString(PS), create)

8+import Data.ByteString.Internal (ByteString(PS), mallocByteString, c_free_finalizer)

9import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)

10−import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)

10+import Foreign.ForeignPtr (newForeignPtr, newForeignPtr_, withForeignPtr)

11import Foreign.Marshal.Alloc (mallocBytes, free)

12import Foreign.Ptr (Ptr, castPtr, plusPtr)

@@ -21,10 +21,18 @@ type BufferPool = IORef ByteString

21newBufferPool :: IO BufferPool

22newBufferPool = newIORef Data.ByteString.empty

24−allocBuffer :: Int -> IO ByteString

24+mallocBuffer :: Int -> IO ByteString

25−allocBuffer size = create size initializer

25+mallocBuffer size = do

26− where initializer = \_ -> return ()

26+ ptr <- mallocBytes size

27−{-# INLINE allocBuffer #-}

27+ fptr <- newForeignPtr c_free_finalizer ptr

28+ return $! PS fptr 0 size

29+{-# INLINE mallocBuffer #-}

30+

31+createBuffer :: Int -> IO ByteString

32+createBuffer size = do

33+ fptr <- mallocByteString size

34+ return $! PS fptr 0 size

35+{-# INLINE createBuffer #-}

29usefulBuffer :: ByteString -> Bool

37usefulBuffer :: ByteString -> Bool

30usefulBuffer buffer = Data.ByteString.length buffer >= minBufferSize

38usefulBuffer buffer = Data.ByteString.length buffer >= minBufferSize

@@ -33,7 +41,7 @@ usefulBuffer buffer = Data.ByteString.length buffer >= minBufferSize

33getBuffer :: BufferPool -> IO ByteString

41getBuffer :: BufferPool -> IO ByteString

34getBuffer pool = do

42getBuffer pool = do

35 buffer <- readIORef pool

43 buffer <- readIORef pool

36− if usefulBuffer buffer then return buffer else allocBuffer largeBufferSize

44+ if usefulBuffer buffer then return buffer else createBuffer largeBufferSize

37{-# INLINE getBuffer #-}

45{-# INLINE getBuffer #-}

39putBuffer :: BufferPool -> ByteString -> IO ()

47putBuffer :: BufferPool -> ByteString -> IO ()

warp/Network/Wai/Handler/Warp/Recv.hs+1−1

@@ -35,7 +35,7 @@ receive sock pool = withBufferPool pool $ \ (ptr, size) -> do

35receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt

36receiveloop sock ptr size = do

37#ifdef mingw32_HOST_OS

38− bytes <- windowsThreadBlockHack $ fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) ptr 0 size

38+ bytes <- windowsThreadBlockHack $ fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) (castPtr ptr) 0 size

39#else

40 bytes <- c_recv sock (castPtr ptr) size 0

41#endif