Permalink
Browse files

Work around an IORef contention problem that slows thread-delay.

This fixes a huge performance regression that I introduced in
82af25a that affected the following
command line:

  benchmarks/thread-delay -n 10000

The regression increased the run time of that program from about
0.2 seconds to a consistent 20 seconds.  The good run time was
erratic, sometimes spiking up to 16 seconds or so, but the bad run
time was very consistent.

I believe that the underlying cause of the problem is
http://hackage.haskell.org/trac/ghc/ticket/3838
  • Loading branch information...
1 parent e70affa commit 29abdc23d7d693e0f050ea81d288c9ba541f20ff Bryan O'Sullivan committed Feb 9, 2010
Showing with 10 additions and 5 deletions.
  1. +10 −5 src/System/Event/Manager.hs
@@ -225,13 +225,13 @@ registerFd_ EventManager{..} cb fd evs = do
let fd' = fromIntegral fd
reg = FdKey fd u
!fdd = FdData reg evs cb
- (!newMap, (oldEvs, newEvs)) =
+ (!newKey, (oldEvs, newEvs)) =
case IM.insertWith (++) fd' [fdd] oldMap of
(Nothing, n) -> (n, (mempty, evs))
- (Just prev, n) -> (n, pairEvents prev newMap fd')
+ (Just prev, n) -> (n, pairEvents prev newKey fd')
modify = oldEvs /= newEvs
when modify $ I.modifyFd emBackend fd oldEvs newEvs
- return (newMap, (reg, modify))
+ return (newKey, (reg, modify))
{-# INLINE registerFd_ #-}
-- | @registerFd mgr cb fd evs@ registers interest in the events @evs@
@@ -304,8 +304,13 @@ registerTimeout mgr ms cb = do
now <- getCurrentTime
let expTime = fromIntegral ms / 1000.0 + now
- !_ <- atomicModifyIORef (emTimeouts mgr) $ \q ->
- let q' = Q.insert key expTime cb q in (q', q')
+ -- We intentionally do not evaluate the modified map to WHNF here.
+ -- Instead, we leave a thunk inside the IORef and defer its
+ -- evaluation until mkTimeout in the event loop. This is a
+ -- workaround for a nasty IORef contention problem that causes the
+ -- thread-delay benchmark to take 20 seconds instead of 0.2.
+ _ <- atomicModifyIORef (emTimeouts mgr) $ \q ->
+ let q' = Q.insert key expTime cb q in (q', q')
wakeManager mgr
return $! TK key

0 comments on commit 29abdc2

Please sign in to comment.