Optimize TimerManager
ClosedPublic

Authored by alexbiehl on Jul 6 2017, 2:16 AM.

Details

Summary

After discussion with Kazu Yamamoto we decided to try two things:

  • replace current finger tree based priority queue through a radix tree based one (code is based on IntPSQ from the psqueues package)
  • after editing the timer queue: don't wake up the timer manager if the next scheduled time didn't change

Benchmark results (number of TimerManager-Operations measured over 20 seconds, 5 runs each, higher is better)

-- baseline (timermanager action commented out)
28817088
28754681
27230541
27267441
28828815

-- ghc-8.3 with wake opt and new timer queue
18085502
17892831
18005256
18791301
17912456

-- ghc-8.3 with old timer queue
6982155
7003572
6834625
6979634
6664339

Here is the benchmark code:

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Strict
import Data.Foldable
import GHC.Event
import System.Random
import Control.Concurrent
import Control.Exception
import Data.IORef

main :: IO ()
main = do

  let seed = 12345 :: Int
      nthreads = 1 :: Int
      benchTime = 20 :: Int -- in seconds

  timerManager <- getSystemTimerManager :: IO TimerManager

  let
    {- worker loop
       depending on the random generator it either
        * registers a new timeout
        * updates existing timeout
        * or cancels an existing timeout

      Additionally it keeps track of a counter tracking how
      often a timermanager was being modified.
    -}
    loop :: IORef Int -> [TimeoutKey] -> StdGen -> IO a
    loop !i !timeouts !rng = do
      let (rand0, rng')   = next rng
          (rand1, rng'')  = next rng'
      case rand0 `mod` 3 of
        0 -> do
          timeout <- registerTimeout timerManager (rand1) (return ())
          modifyIORef' i (+1)
          loop i (timeout:timeouts) rng''
        1 | (timeout:_) <- timeouts
          -> do
            updateTimeout timerManager timeout (rand1)
            modifyIORef' i (+1)
            loop i timeouts rng''
          | otherwise
          -> loop i timeouts rng'
        2
          | (timeout:timeouts') <- timeouts
          -> do
              unregisterTimeout timerManager timeout
              modifyIORef' i (+1)
              loop i timeouts' rng'
          | otherwise -> loop i timeouts rng'

        _ -> loop i timeouts rng'

  let
    -- run a computation which can produce new
    -- random generators on demand
    withRng m = evalStateT m (mkStdGen seed)

    -- split a new random generator
    newRng = do
      (rng1, rng2) <- split <$> get
      put rng1
      return rng2

  counters <- withRng $ do
    replicateM nthreads $ do
      rng <- newRng
      ref <- liftIO (newIORef 0)
      liftIO $ forkIO (loop ref [] rng)
      return ref

  threadDelay (1000000 * benchTime)
  for_ counters $ \ref -> do
    n <- readIORef ref
    putStrLn (show n)

Diff Detail

Repository
rGHC Glasgow Haskell Compiler
Lint
Automatic diff as part of commit; lint not applicable.
Unit
Automatic diff as part of commit; unit tests not applicable.
alexbiehl created this revision.Jul 6 2017, 2:16 AM
alexbiehl updated this revision to Diff 13039.Jul 6 2017, 9:24 AM
  • fix warning
bgamari requested changes to this revision.Jul 6 2017, 10:06 AM

Lovely. Looking forward to seeing how this fares.

This revision now requires changes to proceed.Jul 6 2017, 10:06 AM
Phyx added a subscriber: Phyx.Jul 6 2017, 1:38 PM

I see that you're changing the types, will the external interface change as well?

@Phyx Yes, it does. But now that we are talking about it. It wouldn't be a problem to keep the interface I guess.

alexbiehl updated this revision to Diff 13041.Jul 6 2017, 3:46 PM
alexbiehl edited edge metadata.
  • Reduce interface friction
Phyx added a comment.Jul 6 2017, 3:48 PM

@alexbiehl If it doesn't hinder the patch I would definitely appreciate it :) but if it's better to change the interface I can cope with that too.

Ok, I was able to restore the interface almost to the point where it was. Missing are toAscList and toDescList.

Phyx added a comment.Jul 6 2017, 3:51 PM

Yeah I don't use those so for me that would be fine :)

alexbiehl updated this revision to Diff 13042.Jul 6 2017, 4:34 PM
  • Don't unecessary wake timermanager

If editing the timer queue didn't change the mininum element (== the next timer to fire) don't wake the timer manager.

alexbiehl updated this revision to Diff 13043.Jul 6 2017, 4:37 PM
  • simplification
alexbiehl edited the summary of this revision. (Show Details)Jul 6 2017, 4:40 PM
alexbiehl edited the summary of this revision. (Show Details)
alexbiehl edited the summary of this revision. (Show Details)
alexbiehl edited the summary of this revision. (Show Details)Jul 6 2017, 4:51 PM
alexbiehl retitled this revision from TimerManager: New PSQ based on IntPSQ from psqueues packet to Optimize TimerManager.Jul 6 2017, 4:54 PM
alexbiehl edited the summary of this revision. (Show Details)Jul 6 2017, 4:56 PM
alexbiehl edited the summary of this revision. (Show Details)Jul 7 2017, 1:08 AM
bgamari added a comment.EditedJul 7 2017, 9:27 AM

Quite a nice improvement!

Note to self: I checked the licensing situation of psqueues and it looks like it literally uses the "The Glasgow Haskell Compiler License" BSD3 license, so we have no particular additional obligations under the license AFAICT.

bgamari accepted this revision.Jul 7 2017, 9:29 AM

This looks good to me!

This revision is now accepted and ready to land.Jul 7 2017, 9:29 AM
This revision was automatically updated to reflect the committed changes.