try to gather scattered writes

git upload-pack makes some uncessary writes in sequence, this tries to
gather them together to avoid needing to send multiple DATA packets when
just one will do.

In a small pull, this reduces the average number of DATA packets from
4.5 to 2.5.
This commit is contained in:
Joey Hess 2016-11-21 20:56:58 -04:00
parent 9c311fb564
commit ae69ebfc7c
No known key found for this signature in database
GPG key ID: C910D9222512E3C7

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes, CPP #-}
module Remote.Helper.P2P.IO
( RunProto
@ -179,9 +179,31 @@ relayReader :: MVar RelayData -> Handle -> IO ()
relayReader v hout = loop
where
loop = do
b <- B.hGetSome hout 65536
if B.null b
then return ()
else do
putMVar v $ RelayToPeer (L.fromChunks [b])
bs <- getsome []
case bs of
[] -> return ()
_ -> do
putMVar v $ RelayToPeer (L.fromChunks bs)
loop
-- Waiit for the first available chunk. Then, without blocking,
-- try to get more chunks, in case a stream of chunks is being
-- written in close succession.
--
-- On Windows, hGetNonBlocking is broken, so avoid using it there.
getsome [] = do
b <- B.hGetSome hout chunk
if B.null b
then return []
#ifndef mingw32_HOST_OS
else getsome [b]
#else
else return [b]
#endif
getsome bs = do
b <- B.hGetNonBlocking hout chunk
if B.null b
then return (reverse bs)
else getsome (b:bs)
chunk = 65536