GitLab

Erik de Castro Lopo pushed to branch wip/fix-9809 at Glasgow Haskell Compiler / GHC

Commits:

52b5a986

by Erik de Castro Lopo at 2026-10-28T13:23:24+11:00

TimerManager: publish only evaluated timeout queues (#9809)

When many threads register timeouts at once, for example 100k forked
threads each calling registerDelay or threadDelay, the timer manager
showed huge GC overhead, memory use and timer latency. With 100k forked
registrations on -N4, master took 0.59 s and 437 MB peak memory, against
0.03 s and 31 MB when the same registrations come from one thread.

The cause goes back to 2d5eccdf1c ("IO manager: Edit the timeout queue
directly, rather than using an edit list", fixing #7653), which made every
registration atomicModifyIORef' the shared timeout queue. That publishes
the new queue as a thunk and only evaluates it afterwards, so each thread
builds its O(log n) insert on top of the previous thread's unevaluated
insert, giving thunk chains, threads blocking on each other's partly
evaluated updates, and many queue copies kept alive at once.

Registering threads now use a compare-and-swap loop that evaluates the new
queue before publishing it (IntPSQ is spine strict, so WHNF is fully
evaluated). The timer manager's own update in mkTimeout keeps using
atomicModifyIORef': with compare-and-swap its long update almost never won
against a stream of short inserts on other capabilities, which starved it
and delayed expired timeouts by hundreds of milliseconds.

Forked registrations of 100k timeouts (median of 5 runs):
  -N4:  0.589 s, 437 MB  ->  0.077 s, 37 MB
  -N12: 1.182 s, 465 MB  ->  0.125 s, 74 MB
Forked registrations of 1M timeouts on -N1:
  5.85 s (range 0.69-6.49 s), 1824 MB  ->  0.69 s, 193 MB
Single-thread registrations are unchanged or slightly faster, and timer
latency during registration storms improves (p99 lateness of a 1 ms
threadDelay during 100k forked registrations on -N4: 342-534 ms -> 4-7 ms).

The registration code still runs in constant stack, so #7653 stays fixed;
T7653 and the concurrent, base and ghc-internal testsuites pass.

modifyTimeouts is OPAQUE so that the optimiser cannot expose the edit
function's inspection of the old queue next to the compare-and-swap and
replace the expected pointer with the evaluated queue, which would make the
compare-and-swap fail forever when the MutVar# holds a thunk or indirection.
See Note [Pointer equality in modifyTimeouts].

Regression tests included.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

5 changed files:

+ changelog.d/T9809-timer-manager-contention
libraries/base/tests/.gitignore
+ libraries/base/tests/T9809.hs
libraries/base/tests/all.T
libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs

Changes:

changelog.d/T9809-timer-manager-contention

 +section: ghc-internal
 +synopsis: Fix excessive GC, memory use and timer latency when many threads
 +  register timeouts at once with ``threadDelay``, ``registerDelay`` or
 +  ``System.Timeout.timeout``.
 +issues: #9809
 +mrs: !16863
 +description: {
 +    Threads registering timeouts now publish only fully evaluated updates to
 +    the timer manager's timeout queue, using a compare-and-swap loop, instead
 +    of building chains of unevaluated updates that other threads then had to
 +    evaluate or block on.
 +}

libraries/base/tests/.gitignore

@@ -275,4 +275,5 @@
  /weak001
  /T9395
  /T9532
 +/T9809
  /T11555

libraries/base/tests/T9809.hs

 +-- #9809: when many threads registered timeouts at the same time, the
 +-- TimerManager published unevaluated timeout queues with atomicModifyIORef'.
 +-- The threads then built long chains of thunks and blocked on each other's
 +-- black holes, and the heap grew to hundreds of megabytes. all.T runs this
 +-- test with a heap limit that the old code exceeded.
++
 +import Control.Concurrent
 +import Control.Monad
 +import Data.IORef
 +import GHC.Conc (TVar, atomically, newTVarIO, readTVar, registerDelay, retry, writeTVar)
++
 +main :: IO ()
 +main = do
 +    let n = 100000
 +    ref <- newIORef []
 +    registered <- newTVarIO (0 :: Int)
 +    replicateM_ n . forkIO $ do
 +        tv <- registerDelay 10
 +        atomicModifyIORef' ref (\tvs -> (tv : tvs, ()))
 +        atomically $ readTVar registered >>= writeTVar registered . (+ 1)
 +    atomically $ do
 +        r <- readTVar registered
 +        when (r /= n) retry
 +    readIORef ref >>= mapM_ waitFor
++
 +-- | Block until a delay has fired, so that the test also checks that the
 +-- TimerManager fires every timeout.
 +waitFor :: TVar Bool -> IO ()
 +waitFor tv = atomically $ readTVar tv >>= \fired -> unless fired retry

libraries/base/tests/all.T

@@ -193,6 +193,12 @@ test('T7653', [when(opsys('mingw32'), skip),
                 omit_ways(prof_ways + ghci_ways)], compile_and_run, [''])
  test('T7787', normal, compile_and_run, [''])
 +# Before the fix for #9809 this needed more than 256MB of heap.
 +test('T9809', [req_ghc_smp,
 +               req_target_smp,
 +               only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])],
 +               compile_and_run, ['-threaded -with-rtsopts="-N2 -M128m"'])
++
  test('topHandler01', [when(opsys('mingw32'), skip), js_broken(22261), req_process], compile_and_run, [''])
  test('topHandler02',
       [when(opsys('mingw32'), skip),

libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs

@@ -13,8 +13,10 @@ import GHC.Internal.Types ()
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE ExistentialQuantification #-}
  {-# LANGUAGE FlexibleInstances #-}
 +{-# LANGUAGE MagicHash #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE Trustworthy #-}
 +{-# LANGUAGE UnboxedTuples #-}
  -- TODO: use the new Windows IO manager
  module GHC.Internal.Event.TimerManager
@@ -53,6 +55,9 @@ import GHC.Internal.Control.Exception (finally)
  import GHC.Internal.Data.Foldable (sequence_)
  import GHC.Internal.Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
                     writeIORef)
 +import GHC.Internal.IORef (IORef(..))
 +import GHC.Internal.Prim (casMutVar#, readMutVar#)
 +import GHC.Internal.STRef (STRef(..))
  import GHC.Internal.Err (errorWithoutStackTrace)
  import GHC.Internal.Clock (getMonotonicTimeNSec)
  import GHC.Internal.Conc.Signal (runHandlers)
@@ -260,7 +265,7 @@ updateTimeout mgr (TK key) us = do
  editTimeouts :: TimerManager -> TimeoutEdit -> IO ()
  editTimeouts mgr g = do
 -  wake <- atomicModifyIORef' (emTimeouts mgr) f
 +  wake <- modifyTimeouts (emTimeouts mgr) f
    when wake (wakeManager mgr)
    where
      f q = (q', wake)
@@ -276,4 +281,75 @@ editTimeouts mgr g = do
                        t0 /= t1
                      _ -> True
 +-- | Atomically replace the timeout queue with the first component of
 +-- @f old@ and return the second component.
 +--
 +-- Unlike 'atomicModifyIORef'', the new queue is evaluated /before/ it is
 +-- published, using a compare-and-swap loop. 'atomicModifyIORef'' installs
 +-- the new contents as a thunk and only evaluates it afterwards, so when many
 +-- threads register timeouts at once (#9809) each one builds its insert on
 +-- top of the previous thread's unevaluated insert, giving long thunk chains,
 +-- threads blocking on each other's half evaluated updates and lots of extra
 +-- GC work. Since 'Q.IntPSQ' is spine strict, WHNF means fully evaluated, and
 +-- other threads only ever see a fully evaluated queue.
 +--
 +-- The cost is that a thread whose compare-and-swap loses a race has to redo
 +-- its O(log n) update. The update runs in constant stack (see #7653).
 +--
 +-- Only the short edits made by registering threads use this. The timer
 +-- manager's own update in 'mkTimeout' (removing every expired timeout) can
 +-- take much longer, and under a stream of registrations from other
 +-- capabilities its compare-and-swap would almost never succeed, starving it
 +-- so that expired timeouts don't fire. It therefore keeps using
 +-- 'atomicModifyIORef'', which never retries: it publishes a single thunk and
 +-- evaluates it straight away. A registering thread that reads that thunk
 +-- evaluates it (or waits for the manager to) before publishing its own fully
 +-- evaluated queue, so thunks still cannot pile up.
 +--
 +-- 'casMutVar#' compares pointers, so the expected value must be exactly the
 +-- pointer read from the 'MutVar#'. See Note [Pointer equality in
 +-- modifyTimeouts] for why this function is OPAQUE.
 +{-# OPAQUE modifyTimeouts #-}
 +modifyTimeouts :: IORef TimeoutQueue -> (TimeoutQueue -> (TimeoutQueue, b)) -> IO b
 +modifyTimeouts (IORef (STRef ref)) f = IO modLoop
 +  where
 +    modLoop s0 = case readMutVar# ref s0 of
 +      (# s1, oldVar #) -> case f oldVar of
 +        (newVar, r) -> newVar `seq` case casMutVar# ref oldVar newVar s1 of
 +          (# s2, 0#, _ #) -> (# s2, r #)
 +          (# s2, _, _ #) -> modLoop s2
++
 +{- Note [Pointer equality in modifyTimeouts]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +'casMutVar#' succeeds only if the expected value is the very pointer stored
 +in the 'MutVar#', so all the difficulties of 'reallyUnsafePtrEquality#'
 +apply to it. In 'modifyTimeouts' the expected value is @oldVar@, exactly as
 +'readMutVar#' returned it, and that must survive optimisation.
++
 +The danger is the optimiser seeing a @case@ on @oldVar@ in the same function
 +as the 'casMutVar#'. That would happen if 'modifyTimeouts' were inlined or
 +specialised at a call site, bringing in the body of @f@ (in 'editTimeouts',
 +@f@ inspects the queue to decide whether to wake the manager). The binder
 +swap (Note [Binder swap] in GHC.Core.Opt.OccurAnal) may then replace @oldVar@
 +by the case binder, which is the /evaluated/ queue. That is a different
 +pointer whenever the 'MutVar#' holds a thunk or an indirection, for example
 +the selector thunk that 'atomicModifyIORef'' in 'mkTimeout' leaves behind.
 +Case-of-known-constructor can likewise replace it by a freshly built
 +constructor. Either way the compare-and-swap would keep failing and the
 +registering thread would spin.
++
 +The OPAQUE pragma keeps @f@ an unknown function inside 'modifyTimeouts', so
 +there is never a @case@ on @oldVar@ to rewrite. OPAQUE rather than NOINLINE:
 +both stop inlining and specialisation, but NOINLINE still allows the
 +worker/wrapper transformation. Today that is harmless (the worker only
 +unboxes the 'IORef' and still takes @f@ as an argument), but OPAQUE states
 +the requirement directly: the body must be compiled as written and every call
 +must go to it. It also costs nothing, since 'editTimeouts' passes a closure
 +anyway.
++
 +An alternative is to hide the expected pointer in a box built by a NOINLINE
 +function before @f@ runs (like the @Ticket@ type of the atomic-primops
 +package), but that allocates on every attempt.
 +-}
++
  #endif