Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: dddf7bea by Luite Stegeman at 2026-05-28T22:50:24+02:00 Fixes for black holes - suspend duplicate work for eager black holes - detect eager black holes in checkBlockingQueues - don't overwrite existing black holes even if they're not in an eager blackhole frame - don't deadlock on self when thunk is already blackholed Fixes #26936 (cherry picked from commit 63ce5770da1712f0da54665d8755772bf38ba51e) - - - - - 4433f73d by Tom McLaughlin at 2026-05-28T22:51:40+02:00 Event/Windows.hsc: rethrow exceptions in overlapped IO This prevents the WinIO manager from swallowing exceptions in overlapped IO. It was added to make WinIO support possible in the `network` library. See https://gitlab.haskell.org/ghc/ghc/-/issues/27283. We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP. (cherry picked from commit 037a80dc65d3975adf4a35d46876850e644bc80e) - - - - - 9 changed files: - + changelog.d/fix-blackhole-handling - + changelog.d/windows-rethrow-overlapped-exception - compiler/GHC/SysTools/Cpp.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - rts/Messages.c - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/include/rts/storage/ClosureMacros.h Changes: ===================================== changelog.d/fix-blackhole-handling ===================================== @@ -0,0 +1,6 @@ +section: rts +synopsis: Fix several black hole handling bugs that could lead to deadlocks + or crashes in multithreaded programs. These could show up as the program + hanging or "END_TSO_QUEUE object entered" errors. +issues: #26922 #26936 +mrs: !15640 ===================================== changelog.d/windows-rethrow-overlapped-exception ===================================== @@ -0,0 +1,8 @@ +section: rts +synopsis: Rethrow exceptions in overlapped IO when using the WinIO IO manager. +issues: #27283 +mrs: !15887 + +description: { + This change was made to support WinIO in the network library; see https://github.com/haskell/network/issues/602. +} ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -149,7 +149,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do -- and BUILD is the same as our HOST. let io_manager_defs = - [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] ++ + [ "-D__IO_MANAGER_WINIO__=2" | isWindows ] ++ [ "-D__IO_MANAGER_MIO__=1" ] let sse_defs = ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc ===================================== @@ -687,7 +687,11 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do -- can go into an unbounded alertable wait. delay <- runExpiredTimeouts mgr registerAlertableWait delay - return $ IOFailed Nothing + -- Re-throw the original exception rather than + -- returning IOFailed. This ensures that async + -- exceptions (e.g. Timeout from System.Timeout) + -- propagate correctly to their handlers. + E.throw e let runner = do debugIO $ (dbgMsg ":: waiting ") ++ " | " ++ show lpol res <- readIOPort signal `catch` cancel debugIO $ dbgMsg ":: signaled " ===================================== rts/Messages.c ===================================== @@ -176,10 +176,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) // BLACKHOLE has already been updated, and GC has shorted out the // indirection, so the pointer no longer points to a BLACKHOLE at // all. - if (bh_info != &stg_BLACKHOLE_info && - bh_info != &stg_CAF_BLACKHOLE_info && - bh_info != &__stg_EAGER_BLACKHOLE_info && - bh_info != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(bh_info)) { return 0; } @@ -338,10 +335,7 @@ StgTSO * blackHoleOwner (StgClosure *bh) info = RELAXED_LOAD(&bh->header.info); - if (info != &stg_BLACKHOLE_info && - info != &stg_CAF_BLACKHOLE_info && - info != &__stg_EAGER_BLACKHOLE_info && - info != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(info)) { return NULL; } ===================================== rts/ThreadPaused.c ===================================== @@ -183,6 +183,30 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) } } +/* + * Check whether tso is the owner of the black hole bh. + * + * We must call this from the capability that runs tso, + * since that guarantees that the writes to bh->indirectee + * by tso claiming ownership have been visible. If another + * tso has claimed it again afterwards we can safely suspend + * our work. + */ +static bool +threadPausedBlackHoleOwner(StgTSO *tso, StgClosure *bh) +{ + StgClosure *ind = RELAXED_LOAD(&((StgInd*)bh)->indirectee); + if (ind == (StgClosure*)tso) { + return true; + } + const StgInfoTable *ind_info = GET_INFO(UNTAG_CLOSURE(ind)); + if (ind_info == &stg_BLOCKING_QUEUE_CLEAN_info + || ind_info == &stg_BLOCKING_QUEUE_DIRTY_info) { + return ((StgBlockingQueue*)UNTAG_CLOSURE(ind))->owner == tso; + } + return false; +} + /* ----------------------------------------------------------------------------- * Pausing a thread * @@ -255,11 +279,10 @@ threadPaused(Capability *cap, StgTSO *tso) // Note [suspend duplicate work] // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ // If the info table is a WHITEHOLE or a BLACKHOLE, then - // another thread has claimed it (via the SET_INFO() - // below), or is in the process of doing so. In that case - // we want to suspend the work that the current thread has - // done on this thunk and wait until the other thread has - // finished. + // some thread has claimed it, or is in the process of doing + // so. In that case we want to suspend the work that the + // current thread has done on this thunk and wait until the + // other thread has finished. // // If eager blackholing is taking place, it could be the // case that the blackhole points to the current @@ -287,8 +310,8 @@ threadPaused(Capability *cap, StgTSO *tso) // Note that great care is required when entering computations // suspended by this mechanism. See Note [AP_STACKs must be eagerly // blackholed] for details. - if (((bh_info == &stg_BLACKHOLE_info) - && (RELAXED_LOAD(&((StgInd*)bh)->indirectee) != (StgClosure*)tso)) + if ((IS_BLACKHOLE_INFO(bh_info) + && !threadPausedBlackHoleOwner(tso, bh)) || (bh_info == &stg_WHITEHOLE_info)) { debugTrace(DEBUG_squeeze, @@ -318,14 +341,14 @@ threadPaused(Capability *cap, StgTSO *tso) // If we have a frame that is already eagerly blackholed, we // shouldn't overwrite its payload: There may already be a blocking // queue (see #26324). - if(frame_info == &stg_bh_upd_frame_info) { - // eager black hole: we do nothing - - // it should be a black hole that we own - ASSERT(bh_info == &stg_BLACKHOLE_info || - bh_info == &__stg_EAGER_BLACKHOLE_info || - bh_info == &stg_CAF_BLACKHOLE_info); - ASSERT(blackHoleOwner(bh) == tso || blackHoleOwner(bh) == NULL); + if(frame_info == &stg_bh_upd_frame_info + || IS_BLACKHOLE_INFO(bh_info)) { + // already a black hole: we do nothing + + // it should be a black hole (but we may not own it, as another + // thread could have raced us to claim it) + ASSERT(IS_BLACKHOLE_INFO(bh_info)); + } else { // lazy black hole ===================================== rts/Threads.c ===================================== @@ -439,7 +439,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) // thing the result would be the same in almost all cases. See #20093. p = UNTAG_CLOSURE(bq->bh); const StgInfoTable *pinfo = ACQUIRE_LOAD(&p->header.info); - if (pinfo != &stg_BLACKHOLE_info || + if (!IS_BLACKHOLE_INFO(pinfo) || (RELAXED_LOAD(&((StgInd *)p)->indirectee) != (StgClosure*)bq)) { wakeBlockingQueue(cap,bq); @@ -463,10 +463,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val) const StgInfoTable *i; i = ACQUIRE_LOAD(&thunk->header.info); - if (i != &stg_BLACKHOLE_info && - i != &stg_CAF_BLACKHOLE_info && - i != &__stg_EAGER_BLACKHOLE_info && - i != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(i)) { updateWithIndirection(cap, thunk, val); return; } ===================================== rts/Updates.h ===================================== @@ -190,9 +190,9 @@ * frame is encountered, it checks the info table of the updatee and: * * - if it is `BLACKHOLE`, then the thunk has already been claimed for evaluation - * by another thread, and the yielding thread is instead added to the - * `BLACKHOLE`'s blocking queue (see Note [suspend duplicate work] in - * `ThreadPaused.c`). + * by some thread. If that's not the yielding thread itself, the yielding thread + * is added to the `BLACKHOLE`'s blocking queue (see Note [suspend duplicate + * work] in `ThreadPaused.c`). * * - if not, then it blackholes the thunk as done in eager blackholing (but * using the `BLACKHOLE_info` info table instead of `EAGER_BLACKHOLE_info`). ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -374,6 +374,18 @@ EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void ); EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void ) { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection +/* ----------------------------------------------------------------------------- + Blackhole predicates + -------------------------------------------------------------------------- */ + +#define IS_BLACKHOLE_INFO(info) \ + ((info) == &stg_BLACKHOLE_info || \ + (info) == &__stg_EAGER_BLACKHOLE_info || \ + (info) == &stg_CAF_BLACKHOLE_info) + +#define IS_BLACKHOLE_OR_WHITEHOLE_INFO(info) \ + (IS_BLACKHOLE_INFO(info) || (info) == &stg_WHITEHOLE_info) + /* -------------------------------------------------------------------------- Sizes of closures ------------------------------------------------------------------------*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/007b39e6469126a4e3269a28cabedc9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/007b39e6469126a4e3269a28cabedc9... You're receiving this email because of your account on gitlab.haskell.org.