Commit 7fa3fffe authored by Petr Pudlak's avatar Petr Pudlak
Browse files

Add 'yield' statements in Haskell code

- After a message is sent over the network (even UDS), it takes a
  non-trivial amount of time for a client to parse the message, reply
  and encode a new one. Therefore reading immediately from the network
  just wastes system calls. It has been observed that 'yield'-ing at
  this point saves these system calls, yielding to overall better
  performance.
  See http://www.yesodweb.com/blog/2014/02/new-warp


- Similarly, when an asynchronous writer finishes its job, it makes
  sense to give priority to other threads. This allows the other tasks
  to proceed, resulting in bigger batches of work for the asynchronous
  writer under higher loads.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent f2327e76
......@@ -62,7 +62,7 @@ module Ganeti.UDSServer
) where
import Control.Applicative
import Control.Concurrent.Lifted (fork)
import Control.Concurrent.Lifted (fork, yield)
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Exception (catch)
......@@ -488,8 +488,14 @@ clientLoop
-> m ()
clientLoop handler client = do
result <- handleClient handler client
{- It's been observed sometimes that reading immediately after sending
a response leads to worse performance, as there is nothing to read and
the system calls are just wasted. Thus yielding before reading gives
other threads a chance to proceed and provides a natural pause, leading
to a bit more efficient communication.
-}
if result
then clientLoop handler client
then yield >> clientLoop handler client
else liftBase $ closeClient client
-- | Main listener loop: accepts clients, forks an I/O thread to handle
......
......@@ -61,7 +61,7 @@ import Control.Monad
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Concurrent (ThreadId)
import Control.Concurrent.Lifted (fork)
import Control.Concurrent.Lifted (fork, yield)
import Control.Concurrent.MVar.Lifted
import Data.Functor.Identity
import Data.Monoid
......@@ -112,6 +112,9 @@ mkAsyncWorker act = do
-- been woken up by a trigger that has been
-- already included in the last run
Pending i rs -> act i >>= forM_ rs . flip tryPutMVar
-- Give other threads a chance to do work while we're waiting for
-- something to happen.
yield
return $ AsyncWorker thId ref trig
where
swap :: (MonadBase IO m) => IORef a -> a -> m a
......
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