Duncan Coutts pushed to branch wip/dcoutts/issue-27105-stopTicker at Glasgow Haskell Compiler / GHC Commits: c6c47bbf by Duncan Coutts at 2026-05-12T16:13:29+01:00 Add a test for thread scheduler fairness It also tests that the interval timer and context switching works. We also test that fairness is lost when the context switching interval is too coarse for the duration of the test. We add this test before doing surgery on the interval timer, so we have decent coverage. - - - - - 1c67b588 by Duncan Coutts at 2026-05-12T16:13:29+01:00 Fix for RTS stopTicker not being synchronous Fixes issue #27105. The stopTicker() action was asynchronous (on both posix and win32) but it was being used in several places as if it were synchronous. It turns out there are two uses for stopTicker: 1. for concurrency safety: to avoid the tick handler running concurrently with some other critical section. 2. for efficiency: to reduce CPU wakeups when the RTS goes idle. The first case is where it relies on the stopTicker() being synchronous (which it wasn't), while the second case can be asynchronous for performance. In fact it _must_ be asynchronous because it is called within the tick handler itself, and it cannot wait on itself. So in this patch we deprecate stopTicker/startTicker and replace it with two pairs: block/unblockTicker for case 1, and pause/unpauseTicker for case 2. We update all calls of stop/startTicker with the appropriate replacement. In the posix implementation, we take care to keep the tick action cheap. Since block/unblock are used very infrequently, we make them more expensive and complicated to allow the normal hot path in the tick action to be cheap. We avoid locks and atomic memory ops in the hot path. We use message passing via an eventfd or pipe. In the win32 implementation, we continue to use the TimerQueue API, and we make use of its ability to delete timers synchronously or asynchronously. Add a changelog entry. - - - - - fd3096cd by Duncan Coutts at 2026-05-12T16:13:29+01:00 Make win32 ticker wait interval for initial tick too There is no need to tick immediately. This is consistent with the posix implementation. - - - - - cf90f907 by Duncan Coutts at 2026-05-12T16:13:30+01:00 Remove now-unnecessary layer of RTS ticker block/unblocking There was an atomic variable used to block *part* of the actions of the tick handler. This still did not make stopTimer synchronous, even for the part of the the handle_tick actions it covered. It also added a more expensive (sequentuially consistent) atomic operation in the hot path for the handle_tick action, whereas our new design requires no atomic ops at all. Now that we have a proper synchronous solution, we don't need this not-quite-working-anyway atomic protocol. - - - - - 84ff228b by Duncan Coutts at 2026-05-12T16:13:30+01:00 Add TODOs about issue #27250: too much being done from handle_tick The handle_tick should not perform I/O, block, perform long-running operations or call arbitrary user code. Unfortunately, everything to do with the eventlog (at the moment) falls into all those categories. - - - - - 13 changed files: - + changelog.d/T27105 - rts/Capability.c - rts/RtsStartup.c - rts/Schedule.c - rts/Ticker.h - rts/Timer.c - rts/Timer.h - rts/include/rts/Timer.h - rts/include/stg/SMP.h - rts/posix/Ticker.c - rts/win32/Ticker.c - + testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T Changes: ===================================== changelog.d/T27105 ===================================== @@ -0,0 +1,4 @@ +section: rts +issues: #27105 +mrs: 16023 +synopsis: RTS stopTicker is asynchronous, but is used relying on it being synchronous. ===================================== rts/Capability.c ===================================== @@ -31,6 +31,7 @@ #include "sm/OSMem.h" #include "sm/BlockAlloc.h" // for countBlocks() #include "IOManager.h" +#include "Timer.h" #include <string.h> @@ -448,7 +449,7 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) // as we free it. The alternative would be to protect the capabilities // array with a lock but this seems more expensive than necessary. // See #17289. - stopTimer(); + blockTimer(); if (to == 1) { // THREADED_RTS must work on builds that don't have a mutable @@ -471,7 +472,7 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) debugTrace(DEBUG_sched, "allocated %d more capabilities", to - from); - startTimer(); + unblockTimer(); #endif } ===================================== rts/RtsStartup.c ===================================== @@ -415,8 +415,8 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) traceInitEvent(dumpIPEToEventLog); initHeapProfiling(); - /* start the virtual timer 'subsystem'. */ - startTimer(); + /* start the timer (after initTimer above) */ + unblockTimer(); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { @@ -512,14 +512,12 @@ hs_exit_(bool wait_foreign) } #endif - /* stop the ticker */ - stopTimer(); - /* - * it is quite important that we wait here as some timer implementations - * (e.g. pthread) may fire even after we exit, which may segfault as we've - * already freed the capabilities. + /* We rely on the guarantee that exitTimer stops the timer synchronously, + * which ensures the timer handler does not get run again after this point. + * We are about to start freeing resources used by the timer handler (like + * the capabilities, eventlog and profiling data structures). */ - exitTimer(true); + exitTimer(); /* * Dump the ticky counter definitions ===================================== rts/Schedule.c ===================================== @@ -454,7 +454,7 @@ run_thread: prev = setRecentActivity(ACTIVITY_YES); if (prev == ACTIVITY_DONE_GC) { #if !defined(PROFILING) - startTimer(); + unpauseTimer(); #endif } break; @@ -1935,7 +1935,7 @@ delete_threads_and_gc: // it will get re-enabled if we run any threads after the GC. setRecentActivity(ACTIVITY_DONE_GC); #if !defined(PROFILING) - stopTimer(); + pauseTimer(); #endif break; } @@ -2100,7 +2100,7 @@ forkProcess(HsStablePtr *entry ACQUIRE_LOCK(&all_tasks_mutex); #endif - stopTimer(); // See #4074 + blockTimer(); // See #4074 #if defined(TRACING) flushAllCapsEventsBufs(); // so that child won't inherit dirty file buffers @@ -2110,7 +2110,7 @@ forkProcess(HsStablePtr *entry if (pid) { // parent - startTimer(); // #4074 + unblockTimer(); // #4074 RELEASE_LOCK(&sched_mutex); RELEASE_LOCK(&sm_mutex); @@ -2224,8 +2224,9 @@ forkProcess(HsStablePtr *entry generations[g].threads = END_TSO_QUEUE; } - // On Unix, all timers are reset in the child, so we need to start - // the timer again. + // The timer thread is not present in the child process, so we need + // to initialise the timer again. Note that the timer is in a blocked + // state when we re-init, and this is permitted. initTimer(); // TODO: need to trace various other things in the child @@ -2236,7 +2237,7 @@ forkProcess(HsStablePtr *entry // start timer after the IOManager is initialized // (the idle GC may wake up the IOManager) - startTimer(); + unblockTimer(); // Install toplevel exception handlers, so interruption // signal will be sent to the main thread. @@ -2307,7 +2308,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) // N.B. We must stop the interval timer while we are changing the // capabilities array lest handle_tick may try to context switch // an old capability. See #17289. - stopTimer(); + blockTimer(); stopAllCapabilities(&cap, task); @@ -2394,7 +2395,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) // Notify IO manager that the number of capabilities has changed. notifyIOManagerCapabilitiesChanged(&cap); - startTimer(); + unblockTimer(); rts_unlock(cap); ===================================== rts/Ticker.h ===================================== @@ -12,9 +12,61 @@ typedef void (*TickProc)(int); -void initTicker (Time interval, TickProc handle_tick); -void startTicker (void); -void stopTicker (void); -void exitTicker (bool wait); +/* The ticker is initialised in a blocked state. Use unblockTicker to start. */ +void initTicker (Time interval, TickProc handle_tick); + +/* Stop and terminate the ticker. It does not need to be stopped first. */ +void exitTicker (void); + +/* Block and unblock the ticker handle_tick action. + * + * The blockTicker action is *synchronous*. When it returns the caller is + * guaranteed that the tick action is blocked. The unblockTicker may be + * asynchronous. + * + * These should be used for the purpose of *concurrency safety*: to prevent + * the tick action from running concurrently with some other critical section. + * + * The blockTicker action is moderately expensive (because it is synchronous) + * and the implementation is optimised on the assumption that this action is + * infrequent (e.g. compared to tick frequency). + * + * It is *not* safe to call these functions from within the tick handler itself. + * + * It is safe to use these functions concurrently from multiple threads. They + * are *not* idempotent however: each thread must pair up each blockTicker call + * with exactly one corresponding unblockTicker. Additionally, initTicker acts + * like blockTicker and also must be matched by a corresponding unblockTicker. + */ +void blockTicker(void); +void unblockTicker(void); + +/* Pause and unpause (resume) the ticker. + * + * The pauseTicker and unpauseTicker actions are *asynchronous*. After calling + * pauseTicker, the ticker will pause eventually, but there may be another tick + * action before it does pause (and theoretically there could be several but + * in practice this is unlikely). Similarly, after calling unpauseTicker the + * ticker will start up again eventually, but there is an unspecified delay + * between the unpause and the next tick action (but in practice it is short). + * + * This should be used for the purpose of *efficiency*: to avoid unnecessary + * OS thread wakeups caused by the ticker. + * + * The pairing of unpauseTicker and the handle_tick action form a + * synchonises-with relation: values written before unpauseTicker can be + * read from the resulting handle_tick action. + * + * It *is* safe to call these functions from within the tick handler itself. + * + * It is safe to use these functions concurrently from multiple threads, but + * note that they *are* idempotent. This means it is not appropriate to use + * paired pause/unpause calls concurrently. They can be used by threads based + * on consistent use of some shared state or observation. + */ +void pauseTicker(void); +void unpauseTicker(void); + +void wakeUpRtsViaTicker(void); #include "EndPrivate.h" ===================================== rts/Timer.c ===================================== @@ -33,15 +33,6 @@ #define HAVE_PREEMPTION #endif -// This global counter is used to allow multiple threads to stop the -// timer temporarily with a stopTimer()/startTimer() pair. If -// timer_enabled == 0 timer is enabled -// timer_disabled == N, N > 0 timer is disabled by N threads -// When timer_enabled makes a transition to 0, we enable the timer, -// and when it makes a transition to non-0 we disable it. - -static StgWord timer_disabled; - /* ticks left before next pre-emptive context switch */ static int ticks_to_ctxt_switch = 0; @@ -112,9 +103,9 @@ static void handle_tick(int unused STG_UNUSED) { - handleProfTick(); - if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0 - && SEQ_CST_LOAD_ALWAYS(&timer_disabled) == 0) + handleProfTick(); // Bad or worse: see issue #27250. + + if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) { ticks_to_ctxt_switch--; if (ticks_to_ctxt_switch <= 0) { @@ -128,7 +119,7 @@ handle_tick(int unused STG_UNUSED) ticks_to_eventlog_flush--; if (ticks_to_eventlog_flush <= 0) { ticks_to_eventlog_flush = RtsFlags.TraceFlags.eventlogFlushTicks; - flushEventLog(NULL); + flushEventLog(NULL); // Bad or worse: see issue #27250. } } #endif @@ -153,7 +144,7 @@ handle_tick(int unused STG_UNUSED) RtsFlags.MiscFlags.tickInterval; #if defined(THREADED_RTS) wakeUpRts(); - // The scheduler will call stopTimer() when it has done + // The scheduler will call pauseTimer() when it has done // the GC. #endif } else { @@ -165,10 +156,10 @@ handle_tick(int unused STG_UNUSED) #if defined(PROFILING) if (!(RtsFlags.ProfFlags.doHeapProfile || RtsFlags.CcFlags.doCostCentres)) { - stopTimer(); + pauseTimer(); } #else - stopTimer(); + pauseTimer(); #endif } } else { @@ -181,48 +172,71 @@ handle_tick(int unused STG_UNUSED) } } -void -initTimer(void) +void initTimer() { #if defined(HAVE_PREEMPTION) initProfTimer(); if (RtsFlags.MiscFlags.tickInterval != 0) { initTicker(RtsFlags.MiscFlags.tickInterval, handle_tick); } - SEQ_CST_STORE_ALWAYS(&timer_disabled, 1); #endif } -void -startTimer(void) +/* Deprecated exported functions. Now no-ops. + * Historically they were used by the process and unix libraries to disable + * the signal-based interval timer, since otherwise the timer signal would + * keep going off in the child process and confusing everything. The interval + * timer no longer uses signals, so there is no need any more for libraries to + * disable the timer. Also, the timer internal API has changed. + */ +void stopTimer() { /* no-op */ } +void startTimer() { /* no-op */ } + +/* We allow multiple threads to block the timer temporarily with a + * blockTimer()/unblockTimer() pair. The counting for this is done by + * the ticker implementation when using blockTicker()/unblockTicker(). + */ +void unblockTimer() { #if defined(HAVE_PREEMPTION) - if (SEQ_CST_SUB_ALWAYS(&timer_disabled, 1) == 0) { - if (RtsFlags.MiscFlags.tickInterval != 0) { - startTicker(); - } + if (RtsFlags.MiscFlags.tickInterval != 0) { + unblockTicker(); } #endif } -void -stopTimer(void) +void blockTimer() { #if defined(HAVE_PREEMPTION) - if (SEQ_CST_ADD_ALWAYS(&timer_disabled, 1) == 1) { - if (RtsFlags.MiscFlags.tickInterval != 0) { - stopTicker(); - } + if (RtsFlags.MiscFlags.tickInterval != 0) { + blockTicker(); } #endif } -void -exitTimer (bool wait) +void pauseTimer() +{ +#if defined(HAVE_PREEMPTION) + if (RtsFlags.MiscFlags.tickInterval != 0) { + pauseTicker(); + } +#endif +} + +void unpauseTimer() +{ +#if defined(HAVE_PREEMPTION) + if (RtsFlags.MiscFlags.tickInterval != 0) { + unpauseTicker(); + } +#endif +} + +void exitTimer () { #if defined(HAVE_PREEMPTION) if (RtsFlags.MiscFlags.tickInterval != 0) { - exitTicker(wait); + exitTicker(); } #endif } ===================================== rts/Timer.h ===================================== @@ -8,5 +8,15 @@ #pragma once -RTS_PRIVATE void initTimer (void); -RTS_PRIVATE void exitTimer (bool wait); +#include "BeginPrivate.h" + +void initTimer (void); +void exitTimer (void); + +void blockTimer(void); +void unblockTimer(void); + +void pauseTimer(void); +void unpauseTimer(void); + +#include "EndPrivate.h" ===================================== rts/include/rts/Timer.h ===================================== @@ -13,6 +13,6 @@ #pragma once -void startTimer (void); -void stopTimer (void); +void startTimer (void); // Deprecated: see issue #27086 +void stopTimer (void); // Deprecated: see issue #27086 int rtsTimerSignal (void); // Deprecated: see issue #27073 ===================================== rts/include/stg/SMP.h ===================================== @@ -29,6 +29,8 @@ void arm_atomic_spin_unlock(void); // Acquire/release atomic operations #define ACQUIRE_LOAD_ALWAYS(ptr) __atomic_load_n(ptr, __ATOMIC_ACQUIRE) #define RELEASE_STORE_ALWAYS(ptr,val) __atomic_store_n(ptr, val, __ATOMIC_RELEASE) +#define RELEASE_ADD_ALWAYS(ptr,val) __atomic_add_fetch(ptr, val, __ATOMIC_RELEASE) +#define RELEASE_SUB_ALWAYS(ptr,val) __atomic_sub_fetch(ptr, val, __ATOMIC_RELEASE) // Sequentially consistent atomic operations #define SEQ_CST_LOAD_ALWAYS(ptr) __atomic_load_n(ptr, __ATOMIC_SEQ_CST) ===================================== rts/posix/Ticker.c ===================================== @@ -103,120 +103,237 @@ #include <unistd.h> #include <fcntl.h> -static Time itimer_interval = DEFAULT_TICK_INTERVAL; +static Time ticker_interval = DEFAULT_TICK_INTERVAL; + +// Atomic variable used by client threads to communicate their request to the +// ticker thread to block the ticks. +static int block_request_count; + +// Condition, mutex and cond var to communicate confirmation that the ticker is +// indeed blocked. +static bool block_confirmed; // must hold the mutex to get/set +static Mutex block_confirmed_mutex; +static Condition block_confirmed_cond; + +// Atomic variable used by client threads to communicate that they want the +// ticker thread to pause. This communication is one-way, with no +// acknowledgement. +static bool pause_request; + +#if defined(THREADED_RTS) +// Atomic variable used by the ctl-c handler (posix signal handler) to +// communicate that the ticker thread should wake up the rts. This +// communication is one-way, with no acknowledgement. +static bool interrupt_request; +#endif -// Should we be firing ticks? -// Writers to this must hold the mutex below. -static bool stopped = false; +// Atomic variable used by other threads to communicate that they want the +// ticker thread to exit. +static bool exit_request; +// Used to wait for the ticker thread to terminate after asking it to exit. +static OSThreadId ticker_thread_id; -// should the ticker thread exit? -// This can be set without holding the mutex. -static bool exited = true; +// Fds used with sendFdWakeup to notify the ticker thread that any of the +// *_request variables above have been set. +static int notifyfd_r = -1, notifyfd_w = -1; -// Signaled when we want to (re)start the timer -static Condition start_cond; -static Mutex mutex; -static OSThreadId thread; -// fds for interrupting the ticker -static int interruptfd_r = -1, interruptfd_w = -1; +// Synchronous, request and confirm. Not idempotent. +// Request the ticker to stop ticking, and wait until it confirms +// this. This guarantees no more ticks after this returns. +void blockTicker(void) +{ + // Request + // atomic increment with release memory order + RELEASE_ADD_ALWAYS(&block_request_count, 1); + + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + if (!block_confirmed) { + // Avoid notifying if it's not necessary. This always happens during + // rts startup, since initTicker starts in the blocked state and then + // moreCapabilities() uses block/unblockTicker. + sendFdWakeup(notifyfd_w); + } + // Wait for confirmation + while (!block_confirmed) { + waitCondition(&block_confirmed_cond, &block_confirmed_mutex); + } + OS_RELEASE_LOCK(&block_confirmed_mutex); +} -static void *itimer_thread_func(void *_handle_tick) +// Asynchronous request. Not idempotent. +void unblockTicker(void) { - TickProc handle_tick = _handle_tick; + // Request + RELEASE_SUB_ALWAYS(&block_request_count, 1); + sendFdWakeup(notifyfd_w); +} -#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 - struct pollfd pollfds[1]; +// Asynchronous request. Idempotent. +void pauseTicker(void) +{ + RELEASE_STORE_ALWAYS(&pause_request, true); + sendFdWakeup(notifyfd_w); +} - pollfds[0].fd = interruptfd_r; - pollfds[0].events = POLLIN; +// Asynchronous request. Idempotent. +void unpauseTicker(void) +{ + RELEASE_STORE_ALWAYS(&pause_request, false); + sendFdWakeup(notifyfd_w); +} - struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval) - , .tv_nsec = TimeToNS(itimer_interval) % 1000000000 - }; -#else - fd_set selectfds; - FD_ZERO(&selectfds); - FD_SET(interruptfd_r, &selectfds); - - struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval) - /* convert remainder time in nanoseconds - to microseconds, rounding up: */ - , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000) - + 999) / 1000 - }; +#if defined(THREADED_RTS) +void wakeUpRtsViaTicker(void) +{ + RELAXED_STORE_ALWAYS(&interrupt_request, true); + sendFdWakeup(notifyfd_w); +} #endif - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will - // see it next time. - while (!RELAXED_LOAD_ALWAYS(&exited)) { +// Synchronous. Not idempotent. +// The ticker is guaranteed stopped after this. +void exitTicker () +{ + ASSERT(!RELAXED_LOAD_ALWAYS(&exit_request)); + RELEASE_STORE_ALWAYS(&exit_request, true); + sendFdWakeup(notifyfd_w); + + // wait for ticker thread to terminate + if (pthread_join(ticker_thread_id, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + closeFdWakeup(notifyfd_r, notifyfd_w); + closeMutex(&block_confirmed_mutex); + closeCondition(&block_confirmed_cond); +} #if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 - int nfds = 1; - int nready = ppoll(pollfds, nfds, &ts, NULL); +typedef struct timespec timeout; // for ppoll() +typedef struct { struct pollfd pollfds[1]; } fdset; #else - struct timeval tv_tmp = tv; // copy since select may change this value. - int nfds = interruptfd_r+1; - int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp); +typedef struct timeval timeout; // for select() +typedef struct { int fd; fd_set selectfds; } fdset; // need to stash fd #endif - // In either case (ppoll or select), the result nready is the number - // of fds that are ready. - if (RTS_LIKELY(nready == 0)) { - // Timer expired, not interrupted, continue. - } else if (nready > 0) { - // We only monitor one fd (the interruptfd_r), so we know - // it is that fd that is ready without any further checks. - collectFdWakeup(interruptfd_r); - // No further action needed, continue on to handling the final tick - // and then stop. - - // Note that we rely on sendFdWakeup and select/poll to provide the - // happens-before relation. So if 'exited' was set before calling - // sendFdWakeup, then we should be able to reliably read it after. - // And thus reading 'exited' in the while loop guard is ok. + +// local helpers, to hide the difference between ppoll() and select() +static void poll_init_timeout(timeout *tv, Time t); +static void poll_init_fdset(fdset *fds, int fd); // single fd only +// These two return: >0 if fd ready, ==0 if timeout, <0 if error +static int poll_no_timeout(fdset *fdset); +static int poll_with_timeout(fdset *fdset, timeout *t); + +static void *ticker_thread_func(void *_handle_tick) +{ + TickProc handle_tick = _handle_tick; + + // Thread-local view of our state. We compare these with the corresponding + // atomic shared variables used to request state changes. + bool blocked = true; // compare to atomic shared var block_request_count + bool paused = false; // updated from atomic shared var pause_request + bool exit = false; // updated from atomic shared var exit_request + + timeout timeout; + fdset fdset; + poll_init_timeout(&timeout, ticker_interval); + poll_init_fdset(&fdset, notifyfd_r); + + while (!exit) { + + int notify; + if (blocked || paused) { + notify = poll_no_timeout(&fdset); } else { - // While the RTS attempts to mask signals, some foreign libraries - // that rely on signal delivery may unmask them. Consequently we - // may see EINTR. See #24610. - if (errno != EINTR) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } + notify = poll_with_timeout(&fdset, &timeout); } - // first try a cheap test - if (RELAXED_LOAD_ALWAYS(&stopped)) { - OS_ACQUIRE_LOCK(&mutex); - // should we really stop? - if (stopped) { - waitCondition(&start_cond, &mutex); - } - OS_RELEASE_LOCK(&mutex); - } else { + if (RTS_LIKELY(notify == 0)) { + // The time expired, no state change notification. handle_tick(0); + + } else if (notify > 0) { + // State change notification, check the request variables. + + // We rely on sendFdWakeup and select/poll to provide the + // happens-before relation. So if the request variables are set + // before calling sendFdWakeup, then we should be able to reliably + // read them here afterwards. + collectFdWakeup(notifyfd_r); + + paused = ACQUIRE_LOAD_ALWAYS(&pause_request); + exit = RELAXED_LOAD_ALWAYS(&exit_request); + int block_request_count_snapshot = + ACQUIRE_LOAD_ALWAYS(&block_request_count); + + if (block_request_count_snapshot > 0 && !blocked) { + // State change: !blocked -> blocked + blocked = true; // local state + + // confirm to requesting thread(s) + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + block_confirmed = true; + // Must use broadcastCondition not signalCondition since there + // could be concurrent requesting threads. + broadcastCondition(&block_confirmed_cond); + OS_RELEASE_LOCK(&block_confirmed_mutex); + + } else if (block_request_count_snapshot == 0 && blocked) { + // State change: blocked -> !blocked + blocked = false; // local state + + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + block_confirmed = false; + OS_RELEASE_LOCK(&block_confirmed_mutex); + } + +#if defined(THREADED_RTS) + if (RELAXED_LOAD_ALWAYS(&interrupt_request)) { + RELEASE_STORE_ALWAYS(&interrupt_request, false); + wakeUpRts(); + } +#endif + + } else if (errno != EINTR) { + // While the RTS attempts to mask signals, some foreign libraries + // that rely on signal delivery may unmask them. Consequently we + // may see EINTR. See #24610. + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); } } return NULL; } +/* Initialise the ticker on startup or re-initialise the ticker after a fork(). + * In the fork case, the thread will not be present, but fds are inherited. + * + * The ticker is started in the blocked state. A single unblockTicker should + * be used to unblock. + */ void initTicker (Time interval, TickProc handle_tick) { - itimer_interval = interval; - stopped = true; - exited = false; + ticker_interval = interval; + block_request_count = 1; + pause_request = false; +#if defined(THREADED_RTS) + interrupt_request = false; +#endif + exit_request = false; + #if defined(HAVE_SIGNAL_H) sigset_t mask, omask; int sigret; #endif int ret; - initCondition(&start_cond); - initMutex(&mutex); + block_confirmed = true; + initMutex(&block_confirmed_mutex); + initCondition(&block_confirmed_cond); /* Open the interrupt fd synchronously. * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * We used to do it in ticker_thread_func (i.e. in the timer thread) but it * meant that some user code could run before it and get confused by the * allocation of the timerfd. * @@ -226,11 +343,11 @@ initTicker (Time interval, TickProc handle_tick) * descriptor closed by the first call! (see #20618) */ - if (interruptfd_r != -1) { + if (notifyfd_r != -1) { // don't leak the old file descriptors after a fork (#25280) - closeFdWakeup(interruptfd_r, interruptfd_w); + closeFdWakeup(notifyfd_r, notifyfd_w); } - newFdWakeup(&interruptfd_r, &interruptfd_w); + newFdWakeup(¬ifyfd_r, ¬ifyfd_w); /* * Create the thread with all blockable signals blocked, leaving signal @@ -242,7 +359,7 @@ initTicker (Time interval, TickProc handle_tick) sigfillset(&mask); sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); #endif - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); + ret = createAttachedOSThread(&ticker_thread_id, "ghc_ticker", ticker_thread_func, (void*)handle_tick); #if defined(HAVE_SIGNAL_H) if (sigret == 0) pthread_sigmask(SIG_SETMASK, &omask, NULL); @@ -253,47 +370,65 @@ initTicker (Time interval, TickProc handle_tick) } } -void -startTicker(void) +/* Implementation of the local helpers, to hide the difference between ppoll() + * and select(). + */ +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 +static void poll_init_timeout(timeout *tv, Time t) { - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, false); - signalCondition(&start_cond); - OS_RELEASE_LOCK(&mutex); + tv->tv_sec = TimeToSeconds(t); + tv->tv_nsec = TimeToNS(t) % 1000000000; } -/* There may be at most one additional tick fired after a call to this */ -void -stopTicker(void) +static void poll_init_fdset(fdset *fds, int fd) { - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, true); - OS_RELEASE_LOCK(&mutex); + fds->pollfds[0].fd = fd; + fds->pollfds[0].events = POLLIN; } -/* There may be at most one additional tick fired after a call to this */ -void -exitTicker (bool wait) +static int poll_no_timeout(fdset *fds) { - ASSERT(!SEQ_CST_LOAD(&exited)); - SEQ_CST_STORE(&exited, true); - // ensure that ticker wakes up if stopped - startTicker(); - sendFdWakeup(interruptfd_w); - - // wait for ticker to terminate if necessary - if (wait) { - if (pthread_join(thread, NULL)) { - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); - } - closeFdWakeup(interruptfd_r, interruptfd_w); - closeMutex(&mutex); - closeCondition(&start_cond); - } else { - pthread_detach(thread); - } + int nfds = 1; + return ppoll(fds->pollfds, nfds, NULL, NULL); } +static int poll_with_timeout(fdset *fds, timeout *ts) +{ + int nfds = 1; + return ppoll(fds->pollfds, nfds, ts, NULL); +} + +#else // select() + +static void poll_init_timeout(timeout *tv, Time t) +{ + tv->tv_sec = TimeToSeconds(t); + /* convert remainder time in nanoseconds to microseconds, rounding up: */ + tv->tv_usec = ((TimeToNS(t) % 1000000000) + 999) / 1000; +} + +static void poll_init_fdset(fdset *fds, int fd) +{ + FD_ZERO(&fds->selectfds); + FD_SET(fd, &fds->selectfds); + fds->fd = fd; +} + +static int poll_no_timeout(fdset *fds) +{ + int nfds = fds->fd+1; + return select(nfds, &fds->selectfds, NULL, NULL, NULL); +} + +static int poll_with_timeout(fdset *fds, timeout *tv) +{ + struct timeval tv_tmp = *tv; // copy since select may change this value. + int nfds = fds->fd+1; + return select(nfds, &fds->selectfds, NULL, NULL, &tv_tmp); +} +#endif + +/* This is obsolete, but is used in the unix package for now */ int rtsTimerSignal(void) { ===================================== rts/win32/Ticker.c ===================================== @@ -9,10 +9,14 @@ #include <stdio.h> #include <process.h> +static Time tick_interval = 0; static TickProc tick_proc = NULL; + +static Mutex mutex; // To protect the timer and state vars below static HANDLE timer_queue = NULL; static HANDLE timer = NULL; -static Time tick_interval = 0; +static int blocked_count; +static Bool paused; static VOID CALLBACK tick_callback( PVOID lpParameter STG_UNUSED, @@ -39,9 +43,13 @@ static VOID CALLBACK tick_callback( void initTicker (Time interval, TickProc handle_tick) { + ASSERT(timer_queue == NULL); tick_interval = interval; tick_proc = handle_tick; + OS_INIT_LOCK(mutex); + blocked_count = 1; // starts blocked + paused = false; timer_queue = CreateTimerQueue(); if (timer_queue == NULL) { sysErrorBelch("CreateTimerQueue"); @@ -49,39 +57,94 @@ initTicker (Time interval, TickProc handle_tick) } } -void -startTicker(void) -{ - BOOL r; - - r = CreateTimerQueueTimer(&timer, - timer_queue, - tick_callback, - 0, - 0, - TimeToMS(tick_interval), // ms - WT_EXECUTEINTIMERTHREAD); +static void startTicker(void) { + ASSERT(timer_queue != NULL && timer == NULL); + DWORD interval = TimeToMS(tick_interval); // ms + BOOL r = CreateTimerQueueTimer(&timer, + timer_queue, + tick_callback, + NULL, // callback param + interval, // inital interval + interval, // recurrant interval + WT_EXECUTEINTIMERTHREAD); + //TODO: using WT_EXECUTEINTIMERTHREAD is fine for context switching, and + // plausibly also ok for profile sampling but is way out for eventlog + // flushing. The eventlog flush does a global synchronisation of all + // capabilities and I/O! And with eventlog providers, it calls arbitrary + // user code. This is not ok! See issue #27250. if (r == 0) { sysErrorBelch("CreateTimerQueueTimer"); stg_exit(EXIT_FAILURE); } + ASSERT(timer != NULL); } -void -stopTicker(void) +static void stopTicker(bool synchronous) { + ASSERT(timer_queue != NULL && timer != NULL); + // From the docs for DeleteTimerQueueTimer + // If this parameter is INVALID_HANDLE_VALUE, the function waits for any + // running timer callback functions to complete before returning. + HANDLE completion = synchronous ? INVALID_HANDLE_VALUE : NULL; + DeleteTimerQueueTimer(timer_queue, timer, completion); + timer = NULL; +} + +// Synchronous. Not idempotent. +void blockTicker() { - if (timer_queue != NULL && timer != NULL) { - DeleteTimerQueueTimer(timer_queue, timer, NULL); - timer = NULL; + OS_ACQUIRE_LOCK(mutex); + if (blocked_count == 0 && !paused) { + stopTicker(true /* synchronous */); } + blocked_count++; + OS_RELEASE_LOCK(mutex); } -void -exitTicker (bool wait) +// Asynchronous. Not idempotent. +void unblockTicker() { - stopTicker(); - if (timer_queue != NULL) { - DeleteTimerQueueEx(timer_queue, wait ? INVALID_HANDLE_VALUE : NULL); - timer_queue = NULL; + OS_ACQUIRE_LOCK(mutex); + if (blocked_count == 1 && !paused) { + startTicker(); } + blocked_count--; + OS_RELEASE_LOCK(mutex); +} + +// Asynchronous. Idempotent. +void pauseTicker() +{ + OS_ACQUIRE_LOCK(mutex); + if (!paused && blocked_count == 0) { + /* pauseTicker is called from within the handle_tick, so stopping + * the ticker here /must/ be asynchronous or we will deadlock! */ + stopTicker(false /* asynchronous */); + } + paused = true; + OS_RELEASE_LOCK(mutex); +} + +// Asynchronous. Idempotent. +void unpauseTicker() +{ + OS_ACQUIRE_LOCK(mutex); + if (paused && blocked_count == 0) { + startTicker(); + } + paused = false; + OS_RELEASE_LOCK(mutex); +} + +void exitTicker() +{ + ASSERT(timer_queue != NULL); + blockTicker(); + // From the docs for DeleteTimerQueueEx: + // If this parameter is INVALID_HANDLE_VALUE, the function waits + // for all callback functions to complete before returning. + // This is a belt-and-braces approach to ensuring exitTicker is synchronous, + // since blockTicker() is already synchronous and there's only one timer. + HANDLE completion = INVALID_HANDLE_VALUE; + DeleteTimerQueueEx(timer_queue, completion); + timer_queue = NULL; } ===================================== testsuite/tests/concurrent/should_run/T27105.hs ===================================== @@ -0,0 +1,111 @@ +{-# OPTIONS_GHC -fno-omit-yields #-} + +import Control.Monad +import Control.Monad.ST +import Control.Concurrent +import Control.Exception +import System.Exit +import System.Mem +import GHC.Arr +import Prelude hiding (init) + +-- Test thread fairness: +-- run two cpu-bound threads concurrently for a second, +-- each counts how many operations it can perform until signaled to stop +-- expect a balance between the two with no more than a 10% imperfection. +-- (Actually 30%, see below.) +-- +-- This _should_ detect if the interval timer is not working, or if thread +-- context switching is messed up. We can expect failure if we force a +-- contex switch interval of more than half the test time, i.e. more than 0.5s +-- +-- We run the test twice, with allocating and non-allocating worker threads. +-- The -fno-omit-yields above is crucial for worker_nonalloc below, or it never +-- gets interrupted and thus no context switches. + +main :: IO () +main = do + test worker_alloc + performMajorGC + test worker_nonalloc + +test :: Worker -> IO () +test worker = do + stop <- newEmptyMVar + res1 <- newEmptyMVar + res2 <- newEmptyMVar + _ <- forkIO (worker stop >>= putMVar res1) + _ <- forkIO (worker stop >>= putMVar res2) + threadDelay 300_000 + -- Let them run for 300ms. The default context switch interval is 20ms. + -- This gives time for 15 context switches, so this _should_ be enough + -- to get less than 10% unfairness. And on most platforms it is enough. + -- But OSX! Oh OSX! How do I loath thee? Let me count++ the ways. + -- To avoid a fragile test, we use a 30% unfairness threshold. + putMVar stop () + count1 <- takeMVar res1 + count2 <- takeMVar res2 + let balance :: Double + balance = abs ((fromIntegral count1 - fromIntegral count2) + / fromIntegral count2) + when (balance > 0.3) $ do + putStrLn "Schedule fairness more than 30% tolerance:" + putStrLn $ "imperfection: " ++ show (balance * 100) ++ "%" + putStrLn $ "work counts: " ++ show (count1, count2) + exitFailure + +type Worker = MVar () -> IO Int + +-- count how many iterations we can calculate until we're signaled to stop +worker_template :: IO a -> (a -> IO ()) -> MVar () -> IO Int +worker_template init iter stop = do + a <- init + go a 0 + where + go a !count = do + ok <- tryReadMVar stop + case ok of + Just () -> return count + Nothing -> do + iter a + go a (count + 1) + + +-- the allocating worker +{-# NOINLINE worker_alloc #-} +worker_alloc :: Worker +worker_alloc = + worker_template + (return 18) + (\n -> evaluate (fib n) >> return ()) + +-- by forcing this to be Integer we cause lots of allocation! +fib :: Integer -> Integer +fib 0 = 0 +fib 1 = 1 +fib n = fib (n-1) + fib (n-2) + + +-- the non-allocating worker +{-# NOINLINE worker_nonalloc #-} +worker_nonalloc :: Worker +worker_nonalloc = + worker_template + (stToIO $ newSTArray (0,50_000) 42) + (\arr -> stToIO $ arrrev arr) + +arrrev :: STArray s Int Int -> ST s () +arrrev arr = + let (i,j) = boundsSTArray arr + in arrrev_go arr i j + +{-# NOINLINE arrrev_go #-} +arrrev_go :: STArray s Int Int -> Int -> Int -> ST s () +arrrev_go !_ !i !j | i >= j = return () +arrrev_go !arr !i !j = do + x <- readSTArray arr i + y <- readSTArray arr j + writeSTArray arr i y + writeSTArray arr j x + arrrev_go arr (i+1) (j-1) + ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -325,3 +325,15 @@ test('T26341b' # test uses pipe operations which are not supported by the JS/wasm backends , when(arch('wasm32') or arch('javascript'), skip) , compile_and_run, ['-package process']) + +# Scheduler (very rough) fairness +test('T27105', + [when(arch('wasm32'), skip), # same reason as T367_letnoescape + run_timeout_multiplier(0.05)], # we expect this to run for ~2s + compile_and_run, ['']) +test('T27105_fail', + [when(arch('wasm32'), skip), + # And we can expect it to fail if we context switch too coarsely + extra_run_opts('+RTS -C0.2 -RTS'), expect_fail, + run_timeout_multiplier(0.05)], + multimod_compile_and_run, ['T27105.hs', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498da43766d21705e1746aaeffdf903... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498da43766d21705e1746aaeffdf903... You're receiving this email because of your account on gitlab.haskell.org.