- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/dcoutts/issue-26717] 16 commits: Remove unused tso->block_info.wakeup member
by Duncan Coutts (＠dcoutts) 21 Jul '26

21 Jul '26

Duncan Coutts pushed to branch wip/dcoutts/issue-26717 at Glasgow Haskell Compiler / GHC Commits: 28d9b4db by Duncan Coutts at 2026-07-21T13:52:03+01:00 Remove unused tso->block_info.wakeup member Presumably it was used once, but not now. - - - - - 41689cd2 by Duncan Coutts at 2026-07-21T13:52:11+01:00 Document StgTSOBlockInfo to say what cases use what members In principle, tso->why_blocked is the tag for the StgTSOBlockInfo union, so we should be able to say for each union member the why_blocked cases that use that member. - - - - - b54269a6 by Duncan Coutts at 2026-07-21T13:52:11+01:00 Add a tso->block_info.mvar member and use it in preference to the generic block_info.closure union member, with casts. The plan is that when we know what case we're in (via tso->why_blocked) then we can always access the correct union member, and so we will only need to access block_info.closure for generic cases where we don't know or don't care. - - - - - 2b6e63f9 by Duncan Coutts at 2026-07-21T13:52:11+01:00 Add a tso->block_info.unused member and use it in preference to the generic block_info.closure union member, with casts. The plan is that when we know what case we're in (via tso->why_blocked) then we can always access the correct union member, and so we will only need to access block_info.closure for generic cases where we don't know or don't care. - - - - - c500e1a6 by Duncan Coutts at 2026-07-21T13:52:11+01:00 Avoid storing to tso->block_info.closure In one case we can use a specific union member (.prev) instead. In several cases the stores were in fact redundant because of subsequent overwrites. In scavengeTSO we replace setting tso->block_info.closure to a valid closure, with an assertion that the block_info.unused is already set to END_TSO_QUEUE which is a valid (static) closure. - - - - - 0989884c by Duncan Coutts at 2026-07-21T13:52:11+01:00 Renumber the tso->why_blocked constants We can do this now because we have separated the internal values from the external ones used in the eventlog. This lets us put them back into a deliberate order and consolodate some gaps. More importantly, it is a prepation for a slightly more sophisticated encoding. - - - - - d2ff8432 by Duncan Coutts at 2026-07-21T13:52:11+01:00 Define constants for the existing stg_threadStatuszh return codes The stg_threadStatuszh reuses the internal tso->why_blocked codes but also extends them with a couple previously magic values. This is awkward since we need to know what those magic values are so we don't accidentally use those values to mean something else. By pulling a definition up to where the why_blocked codes are defined we will be able to avoid mistakenly assining those codes some meaning (or just changing the BlockedThreadComplete, BlockedThreadKilled code if necessary). - - - - - 40bc048c by Duncan Coutts at 2026-07-21T13:52:11+01:00 Extend the tso->why_blocked encoding to indicate block_info closures We use some bit tricks to cheaply and generically test if a tso->why_blocked tag implies that the corresponding tso->block_info will contain a non-trivial valid closure (i.e. not just block_info.unused set to END_TSO_QUEUE). In particular we arrange for most why_blocked values to naturally have a distinguishing bit, but for the BlockedOn{Read,Write,Delay} cases, they can come in either non-closure or closure forms. We allow an additional bit to distinguish these cases. The non-closure forms are only from legacy I/O managers: select and win32-legacy. So this extra bit mechanism will be able to be retired once the legacy I/O managers are themselves retired. This means in a few places we need to untag the why_blocked value before inspecting it, but in most places we do not. - - - - - 11bb96ec by Duncan Coutts at 2026-07-21T13:52:11+01:00 Use BlockInfoForceNonClosure in the select I/O manager - - - - - 9b6e3db0 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Use BlockInfoForceNonClosure in the win32-legacy I/O manager for the BlockedOn{Read,Write} since these use the non-heap allocated StgAsyncIOResult. - - - - - f309f939 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Enforce the why_blocked and block_info rules in checkTSO We now check the cases wher IsBlockInfoClosure should hold, the cases that are supposed to use block_info.unused == END_TSO_QUEUE, and which cases are allowed to use BlockInfoForceNonClosure. This partially enforces the use of why_blocked as a tag for the block_info union. We could be stricter and check for the correct expected info table for the closure cases. - - - - - f33be455 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Use IsBlockInfoClosure to simplify several tests In GC and generic traversal we need to know if we should look at the block_info.closure or not. Now we can do just that using a cheap bit test on the why_blocked tag. This fixes issue 26717, where the problem was that some GC modes did not know when to look at block_info.closure, because the poll I/O manager uses a closure for BlockedOn{Read,Write} while the select I/O manager uses a non-closure. Now this information is in the why_blocked tag itself. - - - - - 894b8f61 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Remove the now-unused scavengeTSOIOManager The GC no longer has to delegate to the I/O manager, since it can use IsBlockInfoClosure to decide things itself. - - - - - c51c04a1 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Remove duplicate assertion - - - - - 11ca05c0 by Duncan Coutts at 2026-07-21T13:52:12+01:00 Follow atomic access rules more consistently for tso->why_blocked The rule is this: store block_info *before* why_blocked store why_blocked using store release load why_blocked using load acquire load block_info *after* why_blocked This is a an atomic store release / load acquire pair and (if the reads are in a separate thread to the writes, and the read receives the value stored) then this guarantees a full "happens before" relationship of these stores and loads. In some cases, we do not need a full load acquire, because we don't read the block_info at all and so do not need any ordering. In this case we just need an atomic relaxed load. This was being followed in most places, but not all. If there's good reason in any case that we don't need atomic access, then we should document that in a comment. In the absence of that I think it's easier to follow the rule everywhere. - - - - - 10dff2ef by Duncan Coutts at 2026-07-21T13:55:12+01:00 Add a changelog entry - - - - - 24 changed files: - + changelog.d/T26716 - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs - rts/IOManager.c - rts/IOManager.h - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RaiseAsync.h - rts/STM.c - rts/Schedule.c - rts/Threads.c - rts/TraverseHeap.c - rts/include/rts/Constants.h - rts/include/rts/storage/TSO.h - rts/posix/Poll.c - rts/posix/Select.c - rts/posix/Timeout.c - rts/sm/Compact.c - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Scav.c - rts/win32/AsyncMIO.c Changes: ===================================== changelog.d/T26716 ===================================== @@ -0,0 +1,15 @@ +section: rts +synopsis: Fix design of TSO blocking info, fixing a use-after-free bug +issues: #26716 #26717 +mrs: !15519 +description: { + Experimental work on ASAN support for GHC (MR !15168) revealed a + use-after-free bug when using the combination of the new poll I/O + manager with the compacting GC. The ultimate cause is that a TSO's + `block_info` (used by I/O managers and many other parts of the RTS) + is sometimes a GC pointer and sometimes not, but without a consistent + and easy-to-follow rule for when this is the case. The solution has + been to clean up and enforce that the TSO's `why_blocked` enumeration + is a proper tag for the `block_info`, and to use an encoding that + determines precisely when the `block_info` is a GC pointer or not. +} ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -63,7 +63,7 @@ parseWhatNext w = case w of _ -> WhatNextUnknownValue w parseWhyBlocked :: Word16 -> WhyBlocked -parseWhyBlocked w = case w of +parseWhyBlocked w = case untagWhyBlocked w of (#const NotBlocked) -> NotBlocked (#const BlockedOnMVar) -> BlockedOnMVar (#const BlockedOnMVarRead) -> BlockedOnMVarRead @@ -78,6 +78,9 @@ parseWhyBlocked w = case w of (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating _ -> WhyBlockedUnknownValue w + where + -- See Constants.h encoding for why_blocked + untagWhyBlocked why = why .&. 0x0f parseTsoFlags :: Word32 -> [TsoFlags] parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w) ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -63,7 +63,7 @@ parseWhatNext w = case w of _ -> WhatNextUnknownValue w parseWhyBlocked :: Word16 -> WhyBlocked -parseWhyBlocked w = case w of +parseWhyBlocked w = case untagWhyBlocked w of (#const NotBlocked) -> NotBlocked (#const BlockedOnMVar) -> BlockedOnMVar (#const BlockedOnMVarRead) -> BlockedOnMVarRead @@ -78,6 +78,9 @@ parseWhyBlocked w = case w of (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating _ -> WhyBlockedUnknownValue w + where + -- See Constants.h encoding for why_blocked + untagWhyBlocked why = why .&. 0x0f parseTsoFlags :: Word32 -> [TsoFlags] parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w) ===================================== libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs ===================================== @@ -607,13 +607,16 @@ threadStatus (ThreadId t) = IO $ \s -> -- NB. keep these in sync with rts/include/rts/Constants.h mk_stat 0 = ThreadRunning mk_stat 1 = ThreadBlocked BlockedOnMVar - mk_stat 2 = ThreadBlocked BlockedOnBlackHole - mk_stat 6 = ThreadBlocked BlockedOnSTM + mk_stat 2 = ThreadBlocked BlockedOnMVar -- BlockedOnMVarRead + mk_stat 3 = ThreadBlocked BlockedOnBlackHole + mk_stat 4 = ThreadBlocked BlockedOnException + -- 5,6,7: BlockedOn{Read,Write,Delay} + mk_stat 8 = ThreadBlocked BlockedOnSTM + mk_stat 9 = ThreadBlocked BlockedOnForeignCall mk_stat 10 = ThreadBlocked BlockedOnForeignCall - mk_stat 11 = ThreadBlocked BlockedOnForeignCall - mk_stat 12 = ThreadBlocked BlockedOnException - mk_stat 14 = ThreadBlocked BlockedOnMVar -- possibly: BlockedOnMVarRead - -- NB. these are hardcoded in rts/PrimOps.cmm + -- 11: ThreadMigrating + -- 12: BlockedOnDoProc + -- 13,14,15: unused mk_stat 16 = ThreadFinished mk_stat 17 = ThreadDied mk_stat _ = ThreadBlocked BlockedOnOther ===================================== rts/IOManager.c ===================================== @@ -589,41 +589,6 @@ void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr) } -void scavengeTSOIOManager(StgTSO *tso) -{ - switch (iomgr_type) { - - /* case IO_MANAGER_SELECT: - * BlockedOn{Read,Write} uses block_info.fd - * BlockedOnDelay uses block_info.target - * both of these are not GC pointers, so there is nothing to do. - */ - -#if defined(IOMGR_ENABLED_POLL) - case IO_MANAGER_POLL: - /* BlockedOn{Read,Write} uses block_info.aiop - * BlockedOnDelay uses block_info.timeout - * both of these are heap allocated, so we can do the same in all - * cases, which is why we can use the generic block_info.closure. - */ - evacuate(&tso->block_info.closure); - break; -#endif - - /* case IO_MANAGER_WIN32_LEGACY: - * BlockedOn{Read,Write,DoProc} uses block_info.async_reqID - * which is a plain integer, so nothing to scavenge. - */ - - default: - /* All the other I/O managers do not use I/O-related why_blocked - * reasons, so there are no cases to handle. - */ - break; - } -} - - /* Declared in rts/IOInterface.h. Used only by the MIO threaded I/O manager on * Unix platforms. */ @@ -824,16 +789,17 @@ bool syncIOWaitReady(CapIOManager *iomgr, #if defined(IOMGR_ENABLED_SELECT) case IO_MANAGER_SELECT: { - StgWord why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite; + StgThreadWhyBlocked why_blocked = (rw == IORead ? BlockedOnRead + : BlockedOnWrite) + | BlockInfoForceNonClosure; tso->block_info.fd = fd; - RELEASE_STORE(&tso->why_blocked, why_blocked); appendToIOBlockedQueue(iomgr, tso); + RELEASE_STORE(&tso->why_blocked, why_blocked); return true; } #endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: - ASSERT(tso->why_blocked == NotBlocked); return syncIOWaitReadyPoll(iomgr, tso, rw, fd); #endif default: @@ -890,8 +856,8 @@ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) { LowResTime target = getDelayTarget(us_delay); tso->block_info.target = target; - RELEASE_STORE(&tso->why_blocked, BlockedOnDelay); insertIntoSleepingQueue(iomgr, tso, target); + RELEASE_STORE(&tso->why_blocked, BlockedOnDelay | BlockInfoForceNonClosure); return true; } #endif @@ -911,8 +877,8 @@ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) * simplifies matters, so set the status to OnDoProc and put the * delayed thread on the blocked_queue. */ - RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc); appendToIOBlockedQueue(iomgr, tso); + RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc); return true; } #endif @@ -928,6 +894,7 @@ void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso) switch (iomgr_type) { #if defined(IOMGR_ENABLED_SELECT) case IO_MANAGER_SELECT: + ASSERT(tso->why_blocked == (BlockedOnDelay | BlockInfoForceNonClosure)); removeThreadFromQueue(iomgr->cap, &iomgr->sleeping_queue, tso); break; #endif ===================================== rts/IOManager.h ===================================== @@ -311,11 +311,6 @@ void exitIOManager(bool wait_threads); void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr); -/* GC hook: scavenge I/O related tso->block_info. Used by scavengeTSO. - */ -void scavengeTSOIOManager(StgTSO *tso); - - /* Several code paths are almost identical between read and write paths. In * such cases we use a shared code path with an enum to say which we're doing. */ ===================================== rts/Messages.c ===================================== @@ -267,7 +267,8 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) // NB. we check to make sure that the owner is not the same as // the current thread, since in that case it will not be on // the run queue. - if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) { + if (RELAXED_LOAD(&owner->why_blocked) == NotBlocked && + owner->id != msg->tso->id) { promoteInRunQueue(cap, owner); } @@ -328,7 +329,8 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) msg->tso->id, owner->id); // See above, #3838 - if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) { + if (RELAXED_LOAD(&owner->why_blocked) == NotBlocked && + owner->id != msg->tso->id) { promoteInRunQueue(cap, owner); } ===================================== rts/PrimOps.cmm ===================================== @@ -1145,12 +1145,12 @@ stg_threadStatuszh ( gcptr tso ) // contents of block_info too, then we'd have to do some synchronisation. if (what_next == ThreadComplete) { - ret = 16; // NB. magic, matches up with GHC.Conc.threadStatus + ret = BlockedThreadComplete; // NB. magic, matches up with GHC.Conc.threadStatus } else { if (what_next == ThreadKilled) { - ret = 17; + ret = BlockedThreadKilled; } else { - ret = why_blocked; + ret = UntagWhyBlocked(why_blocked); } } @@ -2319,7 +2319,8 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); - %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32; + %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32 + | BlockInfoForceNonClosure::I32; ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr", CurrentTSO "ptr"); @@ -2339,7 +2340,8 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); - %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32; + %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32 + | BlockInfoForceNonClosure::I32; ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr", CurrentTSO "ptr"); ===================================== rts/RaiseAsync.c ===================================== @@ -233,7 +233,6 @@ throwTo (Capability *cap, // the Capability we hold uint32_t throwToMsg (Capability *cap, MessageThrowTo *msg) { - StgWord status; StgTSO *target = ACQUIRE_LOAD(&msg->target); Capability *target_cap; @@ -268,9 +267,9 @@ check_target: return THROWTO_BLOCKED; } - status = ACQUIRE_LOAD(&target->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&target->why_blocked); - switch (status) { + switch (UntagWhyBlocked(why_blocked)) { case NotBlocked: { if ((target->flags & TSO_BLOCKEX) == 0) { @@ -354,7 +353,7 @@ check_target: StgMVar *mvar; StgInfoTable *info USED_IF_THREADS; - mvar = (StgMVar *)target->block_info.closure; + mvar = target->block_info.mvar; // ASSUMPTION: tso->block_info must always point to a // closure. In the threaded RTS it does. @@ -370,9 +369,10 @@ check_target: // we have the MVar, let's check whether the thread // is still blocked on the same MVar. - if ((target->why_blocked != BlockedOnMVar - && target->why_blocked != BlockedOnMVarRead) - || (StgMVar *)target->block_info.closure != mvar) { + StgThreadWhyBlocked why_blocked_still = ACQUIRE_LOAD(&target->why_blocked); + if (( why_blocked_still != BlockedOnMVar + && why_blocked_still != BlockedOnMVarRead) + || target->block_info.mvar != mvar) { unlockClosure((StgClosure *)mvar, info); goto retry; } @@ -490,7 +490,7 @@ check_target: goto retry; default: - barf("throwTo: unrecognised why_blocked (%d)", target->why_blocked); + barf("throwTo: unrecognised why_blocked (%d)", why_blocked); } barf("throwTo"); } @@ -625,7 +625,7 @@ awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso) static void removeFromMVarBlockedQueue (StgTSO *tso) { - StgMVar *mvar = (StgMVar*)tso->block_info.closure; + StgMVar *mvar = tso->block_info.mvar; StgMVarTSOQueue *q = (StgMVarTSOQueue*)tso->_link; if (q == (StgMVarTSOQueue*)END_TSO_QUEUE) { @@ -667,7 +667,7 @@ removeFromMVarBlockedQueue (StgTSO *tso) static void removeFromQueues(Capability *cap, StgTSO *tso) { - switch (tso->why_blocked) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case NotBlocked: case ThreadMigrating: @@ -721,8 +721,8 @@ removeFromQueues(Capability *cap, StgTSO *tso) } done: - RELAXED_STORE(&tso->why_blocked, NotBlocked); appendToRunQueue(cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } /* ----------------------------------------------------------------------------- @@ -1105,9 +1105,9 @@ done: IF_DEBUG(sanity, checkTSO(tso)); // wake it up - if (tso->why_blocked != NotBlocked) { - tso->why_blocked = NotBlocked; + if (RELAXED_LOAD(&tso->why_blocked) != NotBlocked) { appendToRunQueue(cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } return tso; ===================================== rts/RaiseAsync.h ===================================== @@ -56,7 +56,7 @@ void awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso); INLINE_HEADER int interruptible(StgTSO *t) { - switch (t->why_blocked) { + switch (UntagWhyBlocked(t->why_blocked)) { case BlockedOnMVar: case BlockedOnSTM: case BlockedOnMVarRead: ===================================== rts/STM.c ===================================== @@ -264,7 +264,7 @@ static StgBool cond_lock_tvar(Capability *cap, static void park_tso(StgTSO *tso) { ASSERT(tso -> why_blocked == NotBlocked); - tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE; + tso->block_info.unused = END_TSO_QUEUE; RELEASE_STORE(&tso -> why_blocked, BlockedOnSTM); TRACE("park_tso on tso=%p", tso); } ===================================== rts/Schedule.c ===================================== @@ -181,7 +181,7 @@ static void truncateRunQueue(Capability *cap); static StgTSO *popRunQueue (Capability *cap); static inline EventThreadStatus eventlogThreadStatus(StgThreadReturnCode ret_code); -static inline EventThreadStatus eventlogThreadStatusBlocked(StgWord why_blocked); +static inline EventThreadStatus eventlogThreadStatusBlocked(StgThreadWhyBlocked why_blocked); /* --------------------------------------------------------------------------- Main scheduling loop. @@ -531,7 +531,7 @@ run_thread: #endif if (ret == ThreadBlocked) { - uint16_t why_blocked = ACQUIRE_LOAD(&t->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&t->why_blocked); EventThreadStatus status = eventlogThreadStatusBlocked(why_blocked); StgWord32 status_detail = 0; if (why_blocked == BlockedOnBlackHole) { @@ -1074,7 +1074,7 @@ schedulePostRunThread (Capability *cap, StgTSO *t) // // and a is never equal to b given a consistent view of memory. // - if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) { + if (t -> trec != NO_TREC && RELAXED_LOAD(&t->why_blocked) == NotBlocked) { if (!stmValidateNestOfTransactions(cap, t -> trec, true)) { debugTrace(DEBUG_sched | DEBUG_stm, "trec %p found wasting its time", t); @@ -2506,10 +2506,11 @@ suspendThread (StgRegTable *reg, bool interruptible) threadPaused(cap,tso); + tso->block_info.unused = END_TSO_QUEUE; if (interruptible) { - tso->why_blocked = BlockedOnCCall_Interruptible; + RELEASE_STORE(&tso->why_blocked, BlockedOnCCall_Interruptible); } else { - tso->why_blocked = BlockedOnCCall; + RELEASE_STORE(&tso->why_blocked, BlockedOnCCall); } // Hand back capability @@ -2567,16 +2568,25 @@ resumeThread (void *task_) tso = incall->suspended_tso; incall->suspended_tso = NULL; incall->suspended_cap = NULL; + + // we set why_blocked previously in suspendThread + ASSERT(tso->why_blocked == BlockedOnCCall || + tso->why_blocked == BlockedOnCCall_Interruptible); + // we will modify tso->_link IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *)tso->_link); } tso->_link = END_TSO_QUEUE; + // but no need to modify tso->block_info.prev as coincidentally + // it has the value we want already (since in suspendThread we set + // tso->block_info.unused to END_TSO_QUEUE for BlockedOnCCall). + ASSERT(tso->block_info.prev == END_TSO_QUEUE); traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + RELEASE_STORE(&tso->why_blocked, NotBlocked); if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to @@ -2949,8 +2959,9 @@ deleteThread (StgTSO *tso) // The TSO must be on the run queue of the Capability we own, or // we must own all Capabilities. - if (tso->why_blocked != BlockedOnCCall && - tso->why_blocked != BlockedOnCCall_Interruptible) { + StgThreadWhyBlocked why_blocked = RELAXED_LOAD(&tso->why_blocked); + if (why_blocked != BlockedOnCCall && + why_blocked != BlockedOnCCall_Interruptible) { throwToSingleThreaded(tso->cap,tso,NULL); } } @@ -2961,10 +2972,12 @@ deleteThread_(StgTSO *tso) { // for forkProcess only: // like deleteThread(), but we delete threads in foreign calls, too. - if (tso->why_blocked == BlockedOnCCall || - tso->why_blocked == BlockedOnCCall_Interruptible) { + StgThreadWhyBlocked why_blocked = RELAXED_LOAD(&tso->why_blocked); + if (why_blocked == BlockedOnCCall || + why_blocked == BlockedOnCCall_Interruptible) { tso->what_next = ThreadKilled; appendToRunQueue(tso->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } else { deleteThread(tso); } @@ -3354,7 +3367,7 @@ resurrectThreads (StgTSO *threads) // Wake up the thread on the Capability it was last on cap = tso->cap; - switch (tso->why_blocked) { + switch (UntagWhyBlocked(RELAXED_LOAD(&tso->why_blocked))) { case BlockedOnMVar: case BlockedOnMVarRead: /* Called by GC - sched_mutex lock is currently held. */ @@ -3426,7 +3439,7 @@ static inline EventThreadStatus eventlogThreadStatus(StgThreadReturnCode ret_cod return thread_stop_code[ret_code]; } -static inline EventThreadStatus eventlogThreadStatusBlocked(StgWord why_blocked) +static inline EventThreadStatus eventlogThreadStatusBlocked(StgThreadWhyBlocked why_blocked) { - return thread_blocked_code[why_blocked]; + return thread_blocked_code[UntagWhyBlocked(why_blocked)]; } ===================================== rts/Threads.c ===================================== @@ -97,8 +97,8 @@ createThread(Capability *cap, W_ size) // Always start with the compiled code evaluator tso->what_next = ThreadRunGHC; - tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; - tso->why_blocked = NotBlocked; + tso->block_info.prev = END_TSO_QUEUE; + tso->why_blocked = NotBlocked; tso->blocked_exceptions = END_BLOCKED_EXCEPTIONS_QUEUE; tso->bq = (StgBlockingQueue *)END_TSO_QUEUE; tso->flags = 0; @@ -291,13 +291,12 @@ tryWakeupThread (Capability *cap, StgTSO *tso) } #endif - switch (ACQUIRE_LOAD(&tso->why_blocked)) + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnMVar: case BlockedOnMVarRead: { if (tso->_link == END_TSO_QUEUE) { - tso->block_info.closure = (StgClosure*)END_TSO_QUEUE; goto unblock; } else { return; @@ -336,8 +335,8 @@ tryWakeupThread (Capability *cap, StgTSO *tso) unblock: // just run the thread now, if the BH is not really available, // we'll block again. - tso->why_blocked = NotBlocked; appendToRunQueue(cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); // We used to set the context switch flag here, which would // trigger a context switch a short time in the future (at the end @@ -368,7 +367,8 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to) traceEventMigrateThread (from, tso, to->no); // ThreadMigrating tells the target cap that it needs to be added to // the run queue when it receives the MSG_TRY_WAKEUP. - tso->why_blocked = ThreadMigrating; + tso->block_info.unused = END_TSO_QUEUE; + RELEASE_STORE(&tso->why_blocked, ThreadMigrating); tso->cap = to; tryWakeupThread(from, tso); } @@ -876,9 +876,9 @@ loop: // save why_blocked here, because waking up the thread destroys // this information - StgWord why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); ASSERT(why_blocked == BlockedOnMVarRead || why_blocked == BlockedOnMVar); - ASSERT(tso->block_info.closure == (StgClosure*)mvar); + ASSERT(tso->block_info.mvar == mvar); // actually perform the takeMVar StgStack* stack = tso->stackobj; @@ -949,7 +949,7 @@ end: void printThreadBlockage(StgTSO *tso) { - switch (ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { #if defined(mingw32_HOST_OS) case BlockedOnDoProc: debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID); @@ -968,10 +968,10 @@ printThreadBlockage(StgTSO *tso) #endif break; case BlockedOnMVar: - debugBelch("is blocked on an MVar @ %p", tso->block_info.closure); + debugBelch("is blocked on an MVar @ %p", tso->block_info.mvar); break; case BlockedOnMVarRead: - debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.closure); + debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.mvar); break; break; case BlockedOnBlackHole: @@ -1046,7 +1046,7 @@ printAllThreads(void) debugBelch("other threads:\n"); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (t = generations[g].threads; t != END_TSO_QUEUE; t = next) { - if (t->why_blocked != NotBlocked) { + if (RELAXED_LOAD(&t->why_blocked) != NotBlocked) { printThreadStatus(t); } next = t->global_link; ===================================== rts/TraverseHeap.c ===================================== @@ -1242,15 +1242,12 @@ inner_loop: traversePushClosure(ts, (StgClosure *) tso->blocked_exceptions, c, sep, child_data); traversePushClosure(ts, (StgClosure *) tso->bq, c, sep, child_data); traversePushClosure(ts, (StgClosure *) tso->trec, c, sep, child_data); - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: + + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + if (IsBlockInfoClosure(why_blocked) && why_blocked != NotBlocked) { + // The NotBlocked case uses block_info.prev as a TSO back link. + // Do not follow in that case or we'll get into a loop. traversePushClosure(ts, tso->block_info.closure, c, sep, child_data); - break; - default: - break; } goto loop; } ===================================== rts/include/rts/Constants.h ===================================== @@ -248,33 +248,86 @@ /* * Constants for the why_blocked field of a TSO - * NB. keep these in sync with GHC/Conc/Sync.hs: threadStatus + * + * These say why the TSO is blocked, and also act as the tag for the + * block_info union. The comment for each tag below says which member + * of the block_info union is used. + * + * We also use the why_blocked to determine if the block_info contains + * a closure or not. There are three classes of tag: + * 1. why_blocked tags where block_info is always a closure; + * 2. why_blocked tags where block_info is never a closure; + * 3. why_blocked tags where block_info is sometimes a closure; + * + * We use the following encoding scheme for the three classes above: + * 1. the tag value has bits 3 and 4 unset (values 0..7); + * 2. the tag value has bit 3 set (values 8..15); and + * 3. the tag value has bit 4 set when it is not a closure and unset + * when it is a closure. + * + * This scheme makes it cheap and simple to check if the GC needs to + * look at the block_info.closure. + * + * The reason for the encoding using 2 marker bits rather than 1 is + * that it minimises the cases in the code that need to use or check + * the tag bits. The only tags in class 3 are BlockedOn{Read,Write + * Delay} which are used by in-RTS I/O managers, and the only ones that + * need to use block_info members that are not a closure are the legacy + * I/O managers select and win32-legacy. So when these I/O managers are + * removed then we can simplify the encoding. */ -#define NotBlocked 0 -#define BlockedOnMVar 1 -#define BlockedOnMVarRead 14 /* TODO: renumber me, see #9003 */ -#define BlockedOnBlackHole 2 -#define BlockedOnRead 3 -#define BlockedOnWrite 4 -#define BlockedOnDelay 5 -#define BlockedOnSTM 6 - -/* Win32 only: */ -#define BlockedOnDoProc 7 - -/* Only relevant for THREADED_RTS: */ -#define BlockedOnCCall 10 -#define BlockedOnCCall_Interruptible 11 - /* same as above but permit killing the worker thread */ - -/* Involved in a message sent to tso->msg_cap */ -#define BlockedOnMsgThrowTo 12 +#define BlockInfoForceNonClosure 16 +#define UntagWhyBlocked(why) ((why) & 15) +#define IsBlockInfoClosure(why) (((why) & 24) == 0) +/* + * In the threaded RTS there is an invariant that the block_info union + * is always a valid GC closure. To ensure this, the tags that use + * block_info.unused, always set it to END_TSO_QUEUE. The non-closure + * why_blocked tags are only used by I/O managers on the non-threaded + * RTS. New in-RTS I/O managers use the AIOP and TimeoutQueue mechanism + * which are closures. + * + * Note: keep these in sync with GHC/Conc/Sync.hs: threadStatus + * Note: keep these in sync with Schedule.c: eventlogThreadStatusBlocked which + * converts the constants here to the ones used in the eventlog. + * Note: keep the encoding here in sync with parseWhyBlocked in ghc-heap + */ +#define NotBlocked 0 /* Uses block_info.prev */ +#define BlockedOnMVar 1 /* Uses block_info.mvar */ +#define BlockedOnMVarRead 2 /* Uses block_info.mvar */ +#define BlockedOnBlackHole 3 /* Uses block_info.bh */ +#define BlockedOnMsgThrowTo 4 /* Uses block_info.throwto */ +#define BlockedOnRead 5 /* Uses block_info.aiop + or with BlockInfoForceNonClosure + uses .fd or .async_reqID */ +#define BlockedOnWrite 6 /* Uses block_info.aiop + or with BlockInfoForceNonClosure + uses .fd or .async_reqID */ +#define BlockedOnDelay 7 /* Uses block_info.timeout + or with BlockInfoForceNonClosure + uses .target */ + +#define BlockedOnSTM 8 /* Uses block_info.unused */ +#define BlockedOnCCall 9 /* Uses block_info.unused */ +#define BlockedOnCCall_Interruptible 10 /* Uses block_info.unused + * Same as BlockedOnCCall but permits + * killing the worker thread */ +#define ThreadMigrating 11 /* Uses block_info.unused */ +#define BlockedOnDoProc 12 /* Uses block_info.async_reqID */ + +/* Reserved values, not values that why_blocked currently use. They + * are used in primop stg_threadStatuszh and must not overlap with + * other why_blocked status values. They could be changed, if the + * threadStatus in ghc-internal is updated too. + */ +#define BlockedThreadComplete 16 +#define BlockedThreadKilled 17 -/* The thread is not on any run queues, but can be woken up - by tryWakeupThread() */ -#define ThreadMigrating 13 +/* Next available non-closure why_blocked tag numbers are: 13,14,15 + * For more closure tag numbers, shift up all the non-closure ones + * and adjust the BlockInfoForceNonClosure tag and related macros. + * If we reach BlockInfoForceNonClosure then shift that up. */ -/* Next number is 15. */ /* * These constants are returned to the scheduler by a thread that has @@ -286,6 +339,7 @@ #define ThreadYielding 3 #define ThreadBlocked 4 #define ThreadFinished 5 +/* If this is ever extended, also adjust the eventlogStopStatus mapping */ /* * Flags for the tso->flags field. ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -30,6 +30,15 @@ typedef StgWord64 StgThreadID; #define tsoLocked(tso) ((tso)->flags & TSO_LOCKED) +/* Type for the tso->why_blocked field. See values in Constants.h. + * + * The StgThreadWhyBlocked type could be 8-bits, but for reasons + * unclear it is currently 32-bits. Previous comments here claimed + * that the smallest atomic type on AArch64 is 32-bits, but this is + * false. + */ +typedef StgWord32 StgThreadWhyBlocked; + /* * Type returned after running a thread. Values of this type * include HeapOverflow, StackOverflow etc. See Constants.h for the @@ -37,22 +46,47 @@ typedef StgWord64 StgThreadID; */ typedef unsigned int StgThreadReturnCode; -/* Reason for thread being blocked. See comment above struct StgTso_. */ +/* Additional information about how the thread is blocked. + * The tso->why_blocked is the tag for this union. */ typedef union { + /* Used for generic read, for cases where block_info is a closure. + * Never used for writes. Use .unused below instead. */ StgClosure *closure; - StgTSO *prev; // a back-link when the TSO is on the run queue (NotBlocked) + + /* For why_blocked cases where block_info is unused, this will be set to + * END_TSO_QUEUE, to maintain invariant that block_info.closure is valid */ + StgTSO *unused; + + /* case NotBlocked: A back-link when the TSO is on the run queue */ + StgTSO *prev; + + /* case BlockedOnMVar, BlockedOnMVarRead: the mvar the TSO is blocked on */ + StgMVar *mvar; + + /* case BlockedOnBlackHole */ struct MessageBlackHole_ *bh; + + /* case BlockedOnMsgThrowTo */ struct MessageThrowTo_ *throwto; - struct MessageWakeup_ *wakeup; + + /* case BlockedOnRead, BlockedOnWrite: legacy select I/O manager */ StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ + + /* case BlockedOnRead, BlockedOnWrite: new I/O managers */ StgAsyncIOOp *aiop; + + /* case BlockedOnDelay: new I/O managers */ StgTimeoutQueue *timeout; + #if defined(mingw32_HOST_OS) - // Only used by the Legacy Win32 I/O manager: the async request id for the - // operation. + /* case BlockedOnRead, BlockedOnWrite, BlockedOnDoProc: + * only used by the win32-legacy I/O manager. + * This is the async request id for the operation. */ StgWord async_reqID; #endif + #if !defined(THREADED_RTS) + /* case BlockedOnDelay: used by the select I/O manager */ StgWord target; // Only for the legacy select I/O manager: the target time for a thread // blocked in threadDelay, in units of 1ms. This is a compromise: we don't @@ -73,7 +107,21 @@ typedef union { * have the reason in the why_blocked field of the TSO, and some * further info (such as the closure the thread is blocked on, or the * file descriptor if the thread is waiting on I/O) in the block_info - * field. + * field. See Constants.h for the why_blocked values. + * + * The why_blocked field must be updated atomically. The protocol for + * updating block_info and why_blocked fields together is as follows: + * + * Writes: + * - first write block_info (normal non-atomic write) + * - then write why_blocked with an atomic *store release* + * + * Reads: + * - first read why_blocked with an atomic *load acquire* + * - then read block_info (normal non-atomic read) + * + * Read of only why_blocked without block_info: + * - read why_blocked with an atomic *relaxed load* */ typedef struct StgTSO_ { @@ -123,11 +171,7 @@ typedef struct StgTSO_ { StgWord16 what_next; // Values defined in Constants.h StgWord32 flags; // Values defined in Constants.h - /* - * N.B. why_blocked only has a handful of values but must be atomically - * updated; the smallest width which AArch64 supports for is 32-bits. - */ - StgWord32 why_blocked; // Values defined in Constants.h + StgThreadWhyBlocked why_blocked; // Values defined in Constants.h StgTSOBlockInfo block_info; // Barrier provided by why_blocked StgThreadID id; StgWord32 saved_errno; ===================================== rts/posix/Poll.c ===================================== @@ -183,8 +183,9 @@ bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, aiop->notify.tso = tso; aiop->notify_type = NotifyTSO; aiop->live = &stg_ASYNCIO_LIVE0_closure; - tso->why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite; tso->block_info.aiop = aiop; + RELEASE_STORE(&tso->why_blocked, rw == IORead ? BlockedOnRead + : BlockedOnWrite); return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd); } @@ -230,7 +231,6 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso) * We don't put the TSO back on the run queue or change the why_blocked * status, as that is done by removeFromQueues (in the throwTo* functions). */ - tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; /* We are in the TSO case, where the aiop was only reachable from the TSO * itself, and thus it is now no longer be reachable at all. @@ -300,10 +300,9 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) * cap because the tso was not on the run queue of any cap and * so is not subject to thread migration. */ - StgTSO *tso = aiop->notify.tso; - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; + StgTSO *tso = aiop->notify.tso; pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } /* For the TSO case, the aiop was only reachable from the TSO * itself, and thus it is now no longer be reachable at all. ===================================== rts/posix/Select.c ===================================== @@ -138,11 +138,10 @@ static bool wakeUpSleepingThreads (CapIOManager *iomgr, LowResTime now) break; } iomgr->sleeping_queue = tso->_link; - RELAXED_STORE(&tso->why_blocked, NotBlocked); - tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); flag = true; } return flag; @@ -311,7 +310,7 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) * So the (int) cast should be removed across the code base once * GHC requires a version of FreeBSD that has that change in it. */ - switch (ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: { int fd = tso->block_info.fd; @@ -449,7 +448,7 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) int fd; enum FdState fd_state = RTS_FD_IS_BLOCKING; - switch (tso->why_blocked) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: fd = tso->block_info.fd; @@ -488,9 +487,8 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) IF_DEBUG(scheduler, debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; case RTS_FD_IS_BLOCKING: if (prev == NULL) ===================================== rts/posix/Timeout.c ===================================== @@ -48,8 +48,8 @@ bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) initElemTimeoutQueue(timeout, notify, NotifyTSO, iomgr->cap->r.rCCCS); ASSERT(tso->why_blocked == NotBlocked); - tso->why_blocked = BlockedOnDelay; tso->block_info.timeout = timeout; + RELEASE_STORE(&tso->why_blocked, BlockedOnDelay); insertTimeoutQueue(&iomgr->timeout_queue, timeout, target); @@ -67,8 +67,6 @@ void syncDelayCancelTimeout(CapIOManager *iomgr, StgTSO *tso) deleteTimeoutQueue(&iomgr->timeout_queue, timeout); - tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; - /* the timeout is no longer accessible from anywhere (except here) */ IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(iomgr->cap, (StgClosure *)timeout); @@ -118,10 +116,9 @@ static void notifyTimeoutCompletion(CapIOManager *iomgr, StgTimeout *timeout) switch (timeout->notify_type) { case NotifyTSO: { - StgTSO *tso = timeout->notify.tso; - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; + StgTSO *tso = timeout->notify.tso; pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; } case NotifyMVar: ===================================== rts/sm/Compact.c ===================================== @@ -468,16 +468,10 @@ thread_TSO (StgTSO *tso) thread_(&tso->_link); thread_(&tso->global_link); - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { + /* This also follows the block_info.prev back-link in + * the NotBlocked case, which may not be necessary. */ thread_(&tso->block_info.closure); - break; - default: - break; } thread_(&tso->blocked_exceptions); thread_(&tso->bq); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -1055,16 +1055,10 @@ trace_tso (MarkQueue *queue, StgTSO *tso) if (tso->label != NULL) { markQueuePushClosure_(queue, (StgClosure *) tso->label); } - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { + /* This also follows the block_info.prev back-link in + * the NotBlocked case, which may not be necessary. */ markQueuePushClosure_(queue, tso->block_info.closure); - break; - default: - break; } } ===================================== rts/sm/Sanity.c ===================================== @@ -779,13 +779,45 @@ checkTSO(StgTSO *tso) info == &stg_WHITEHOLE_info); // used to happen due to STM doing // lockTSO(), might not happen now - if ( tso->why_blocked == BlockedOnMVar - || tso->why_blocked == BlockedOnMVarRead - || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnMsgThrowTo - || tso->why_blocked == NotBlocked - ) { + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + switch (why_blocked) { + case NotBlocked: + case BlockedOnMVar: + case BlockedOnMVarRead: + case BlockedOnBlackHole: + case BlockedOnMsgThrowTo: + case BlockedOnRead: + case BlockedOnWrite: + case BlockedOnDelay: + //TODO: we could be more specific and check BlockedOnMVar has an MVar, + // BlockedOnBlackHole has a message, BlockedOnRead has an AIOP etc. + ASSERT(IsBlockInfoClosure(why_blocked)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + break; + + case BlockedOnSTM: + case BlockedOnCCall: + case BlockedOnCCall_Interruptible: + case ThreadMigrating: + ASSERT(!IsBlockInfoClosure(why_blocked)); + ASSERT(tso->block_info.unused == END_TSO_QUEUE); + break; + +#if !defined(THREADED_RTS) + // Only these three can use BlockInfoForceNonClosure + case BlockedOnRead | BlockInfoForceNonClosure: + case BlockedOnWrite | BlockInfoForceNonClosure: + case BlockedOnDelay | BlockInfoForceNonClosure: +#if defined(mingw32_HOST_OS) + case BlockedOnDoProc: +#endif + ASSERT(!IsBlockInfoClosure(why_blocked)); + break; +#endif + + default: + barf("checkTSO: strange tso->why_blocked: %d for TSO %" + FMT_StgThreadID " (%p)", why_blocked, tso->id, tso); } ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ===================================== rts/sm/Scav.c ===================================== @@ -138,29 +138,16 @@ scavengeTSO (StgTSO *tso) evacuate((StgClosure **)&tso->label); } - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { evacuate(&tso->block_info.closure); - break; - case BlockedOnRead: - case BlockedOnWrite: - case BlockedOnDelay: - case BlockedOnDoProc: - scavengeTSOIOManager(tso); - break; - default: + } else { #if defined(THREADED_RTS) // in the THREADED_RTS, block_info.closure must always point to a // valid closure, because we assume this in throwTo(). In the // non-threaded RTS it might be a FD (for // BlockedOnRead/BlockedOnWrite) or a time value (BlockedOnDelay) - tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + ASSERT(tso->block_info.unused == END_TSO_QUEUE); #endif - break; } tso->dirty = gct->failed_to_evac; ===================================== rts/win32/AsyncMIO.c ===================================== @@ -304,7 +304,7 @@ start: for(tso = iomgr->blocked_queue_hd; tso != END_TSO_QUEUE; tso = tso->_link) { - switch(ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: case BlockedOnWrite: case BlockedOnDoProc: @@ -324,8 +324,6 @@ start: } // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // For stg_block_async frames (read/write/doProc), // write len and errCode directly to the stack. // For stg_block_noregs frames (delay), nothing @@ -335,14 +333,14 @@ start: tso->stackobj->sp[2] = (W_)errCode; } pushOnRunQueue(&MainCapability, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; } break; - default: - if (tso->why_blocked != NotBlocked) { - barf("awaitRequests: odd thread state"); - } + case NotBlocked: break; + default: + barf("awaitRequests: odd thread state"); } prev = tso; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e233ebde3d58c18bad7a8ffc7f2011… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e233ebde3d58c18bad7a8ffc7f2011… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/27532
by Zubin (＠wz1000) 21 Jul '26

21 Jul '26

Zubin pushed new branch wip/27532 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/27532 You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/dcoutts/issue-26717] 2 commits: Fixup: Renumber the tso->why_blocked constants
by Duncan Coutts (＠dcoutts) 21 Jul '26

21 Jul '26

Duncan Coutts pushed to branch wip/dcoutts/issue-26717 at Glasgow Haskell Compiler / GHC Commits: 9490d849 by Duncan Coutts at 2026-07-21T13:32:27+01:00 Fixup: Renumber the tso->why_blocked constants a function got renamed after the comment was written - - - - - e233ebde by Duncan Coutts at 2026-07-21T13:33:21+01:00 Fixup ghc-heap to follow new encoding of why_blocked codes Spotted by Cheng Shao during code review. TODO: squash into: "Extend the tso->why_blocked encoding to indicate block_info closures" - - - - - 3 changed files: - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - rts/include/rts/Constants.h Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -63,7 +63,7 @@ parseWhatNext w = case w of _ -> WhatNextUnknownValue w parseWhyBlocked :: Word16 -> WhyBlocked -parseWhyBlocked w = case w of +parseWhyBlocked w = case untagWhyBlocked w of (#const NotBlocked) -> NotBlocked (#const BlockedOnMVar) -> BlockedOnMVar (#const BlockedOnMVarRead) -> BlockedOnMVarRead @@ -78,6 +78,9 @@ parseWhyBlocked w = case w of (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating _ -> WhyBlockedUnknownValue w + where + -- See Constants.h encoding for why_blocked + untagWhyBlocked why = why .&. 0x0f parseTsoFlags :: Word32 -> [TsoFlags] parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w) ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -63,7 +63,7 @@ parseWhatNext w = case w of _ -> WhatNextUnknownValue w parseWhyBlocked :: Word16 -> WhyBlocked -parseWhyBlocked w = case w of +parseWhyBlocked w = case untagWhyBlocked w of (#const NotBlocked) -> NotBlocked (#const BlockedOnMVar) -> BlockedOnMVar (#const BlockedOnMVarRead) -> BlockedOnMVarRead @@ -78,6 +78,9 @@ parseWhyBlocked w = case w of (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating _ -> WhyBlockedUnknownValue w + where + -- See Constants.h encoding for why_blocked + untagWhyBlocked why = why .&. 0x0f parseTsoFlags :: Word32 -> [TsoFlags] parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w) ===================================== rts/include/rts/Constants.h ===================================== @@ -288,8 +288,9 @@ * which are closures. * * Note: keep these in sync with GHC/Conc/Sync.hs: threadStatus - * Note: keep these in sync with Schedule.c: eventlogStopStatus which + * Note: keep these in sync with Schedule.c: eventlogThreadStatusBlocked which * converts the constants here to the ones used in the eventlog. + * Note: keep the encoding here in sync with parseWhyBlocked in ghc-heap */ #define NotBlocked 0 /* Uses block_info.prev */ #define BlockedOnMVar 1 /* Uses block_info.mvar */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40dc6744d655b9c82d32384f493288… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40dc6744d655b9c82d32384f493288… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/dcoutts/issue-26717] 13 commits: Fixup name of old .async_result, it's now async_reqID
by Duncan Coutts (＠dcoutts) 21 Jul '26

21 Jul '26

Duncan Coutts pushed to branch wip/dcoutts/issue-26717 at Glasgow Haskell Compiler / GHC Commits: 3ea1f237 by Duncan Coutts at 2026-07-21T13:16:35+01:00 Fixup name of old .async_result, it's now async_reqID That bit changed in master after the MR was first written. TODO: fixup into previous commit after code review - - - - - c43b9929 by Duncan Coutts at 2026-07-21T13:17:30+01:00 Define constants for the existing stg_threadStatuszh return codes The stg_threadStatuszh reuses the internal tso->why_blocked codes but also extends them with a couple previously magic values. This is awkward since we need to know what those magic values are so we don't accidentally use those values to mean something else. By pulling a definition up to where the why_blocked codes are defined we will be able to avoid mistakenly assining those codes some meaning (or just changing the BlockedThreadComplete, BlockedThreadKilled code if necessary). - - - - - 4aca39e4 by Duncan Coutts at 2026-07-21T13:20:52+01:00 Extend the tso->why_blocked encoding to indicate block_info closures We use some bit tricks to cheaply and generically test if a tso->why_blocked tag implies that the corresponding tso->block_info will contain a non-trivial valid closure (i.e. not just block_info.unused set to END_TSO_QUEUE). In particular we arrange for most why_blocked values to naturally have a distinguishing bit, but for the BlockedOn{Read,Write,Delay} cases, they can come in either non-closure or closure forms. We allow an additional bit to distinguish these cases. The non-closure forms are only from legacy I/O managers: select and win32-legacy. So this extra bit mechanism will be able to be retired once the legacy I/O managers are themselves retired. This means in a few places we need to untag the why_blocked value before inspecting it, but in most places we do not. - - - - - 9c55e3c2 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Use BlockInfoForceNonClosure in the select I/O manager - - - - - e4e4a32c by Duncan Coutts at 2026-07-21T13:20:55+01:00 Use BlockInfoForceNonClosure in the win32-legacy I/O manager for the BlockedOn{Read,Write} since these use the non-heap allocated StgAsyncIOResult. - - - - - eeb795a2 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Enforce the why_blocked and block_info rules in checkTSO We now check the cases wher IsBlockInfoClosure should hold, the cases that are supposed to use block_info.unused == END_TSO_QUEUE, and which cases are allowed to use BlockInfoForceNonClosure. This partially enforces the use of why_blocked as a tag for the block_info union. We could be stricter and check for the correct expected info table for the closure cases. - - - - - 37cfcd73 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Use IsBlockInfoClosure to simplify several tests In GC and generic traversal we need to know if we should look at the block_info.closure or not. Now we can do just that using a cheap bit test on the why_blocked tag. This fixes issue 26717, where the problem was that some GC modes did not know when to look at block_info.closure, because the poll I/O manager uses a closure for BlockedOn{Read,Write} while the select I/O manager uses a non-closure. Now this information is in the why_blocked tag itself. - - - - - 0afedcf5 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Remove the now-unused scavengeTSOIOManager The GC no longer has to delegate to the I/O manager, since it can use IsBlockInfoClosure to decide things itself. - - - - - 51b04410 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Remove duplicate assertion - - - - - a553a482 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Follow atomic access rules more consistently for tso->why_blocked The rule is this: store block_info *before* why_blocked store why_blocked using store release load why_blocked using load acquire load block_info *after* why_blocked This is a an atomic store release / load acquire pair and (if the reads are in a separate thread to the writes, and the read receives the value stored) then this guarantees a full "happens before" relationship of these stores and loads. In some cases, we do not need a full load acquire, because we don't read the block_info at all and so do not need any ordering. In this case we just need an atomic relaxed load. This was being followed in most places, but not all. If there's good reason in any case that we don't need atomic access, then we should document that in a comment. In the absence of that I think it's easier to follow the rule everywhere. - - - - - 6fa2d9be by Duncan Coutts at 2026-07-21T13:20:55+01:00 Add a changelog entry - - - - - 573b54eb by Duncan Coutts at 2026-07-21T13:20:55+01:00 Fix two non-atomic uses of ->why_blocked spotted by Cheng Shao during code review - - - - - 40dc6744 by Duncan Coutts at 2026-07-21T13:20:55+01:00 Fix the category of BlockedOnDoProc in checkTSO It is not in the category where block_info.unused is set, but in the category where the thing is not a closure at all. It is the odd-one-out by being unconditional, so does not use BlockInfoForceNonClosure. TODO: squash into commit: "Enforce the why_blocked and block_info rules in checkTSO" - - - - - 20 changed files: - + changelog.d/T26716 - rts/IOManager.c - rts/IOManager.h - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RaiseAsync.h - rts/Schedule.c - rts/Threads.c - rts/TraverseHeap.c - rts/include/rts/Constants.h - rts/include/rts/storage/TSO.h - rts/posix/Poll.c - rts/posix/Select.c - rts/posix/Timeout.c - rts/sm/Compact.c - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Scav.c - rts/win32/AsyncMIO.c Changes: ===================================== changelog.d/T26716 ===================================== @@ -0,0 +1,15 @@ +section: rts +synopsis: Fix a use-after-free bug in the poll I/O manager +issues: #26716 #26717 +mrs: !15519 +description: { + Experimental work on ASAN support for GHC (MR !15168) revealed a + use-after-free bug when using the combination of the new poll I/O + manager with the compacting GC. The ultimate cause is that a TSO's + `block_info` (used by I/O managers and many other parts of the RTS) + is sometimes a GC pointer and sometimes not, but without a consistent + and easy-to-follow rule for when this is the case. The solution has + been to clean up and enforce that the TSO's `why_blocked` enumeration + is a proper tag for the `block_info`, and to use an encoding that + determines precisely when the `block_info` is a pointer or not. +} ===================================== rts/IOManager.c ===================================== @@ -589,41 +589,6 @@ void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr) } -void scavengeTSOIOManager(StgTSO *tso) -{ - switch (iomgr_type) { - - /* case IO_MANAGER_SELECT: - * BlockedOn{Read,Write} uses block_info.fd - * BlockedOnDelay uses block_info.target - * both of these are not GC pointers, so there is nothing to do. - */ - -#if defined(IOMGR_ENABLED_POLL) - case IO_MANAGER_POLL: - /* BlockedOn{Read,Write} uses block_info.aiop - * BlockedOnDelay uses block_info.timeout - * both of these are heap allocated, so we can do the same in all - * cases, which is why we can use the generic block_info.closure. - */ - evacuate(&tso->block_info.closure); - break; -#endif - - /* case IO_MANAGER_WIN32_LEGACY: - * BlockedOn{Read,Write,DoProc} uses block_info.async_reqID - * which is a plain integer, so nothing to scavenge. - */ - - default: - /* All the other I/O managers do not use I/O-related why_blocked - * reasons, so there are no cases to handle. - */ - break; - } -} - - /* Declared in rts/IOInterface.h. Used only by the MIO threaded I/O manager on * Unix platforms. */ @@ -824,16 +789,17 @@ bool syncIOWaitReady(CapIOManager *iomgr, #if defined(IOMGR_ENABLED_SELECT) case IO_MANAGER_SELECT: { - StgWord why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite; + StgThreadWhyBlocked why_blocked = (rw == IORead ? BlockedOnRead + : BlockedOnWrite) + | BlockInfoForceNonClosure; tso->block_info.fd = fd; - RELEASE_STORE(&tso->why_blocked, why_blocked); appendToIOBlockedQueue(iomgr, tso); + RELEASE_STORE(&tso->why_blocked, why_blocked); return true; } #endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: - ASSERT(tso->why_blocked == NotBlocked); return syncIOWaitReadyPoll(iomgr, tso, rw, fd); #endif default: @@ -890,8 +856,8 @@ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) { LowResTime target = getDelayTarget(us_delay); tso->block_info.target = target; - RELEASE_STORE(&tso->why_blocked, BlockedOnDelay); insertIntoSleepingQueue(iomgr, tso, target); + RELEASE_STORE(&tso->why_blocked, BlockedOnDelay | BlockInfoForceNonClosure); return true; } #endif @@ -911,8 +877,8 @@ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) * simplifies matters, so set the status to OnDoProc and put the * delayed thread on the blocked_queue. */ - RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc); appendToIOBlockedQueue(iomgr, tso); + RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc); return true; } #endif @@ -928,6 +894,7 @@ void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso) switch (iomgr_type) { #if defined(IOMGR_ENABLED_SELECT) case IO_MANAGER_SELECT: + ASSERT(tso->why_blocked == (BlockedOnDelay | BlockInfoForceNonClosure)); removeThreadFromQueue(iomgr->cap, &iomgr->sleeping_queue, tso); break; #endif ===================================== rts/IOManager.h ===================================== @@ -311,11 +311,6 @@ void exitIOManager(bool wait_threads); void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr); -/* GC hook: scavenge I/O related tso->block_info. Used by scavengeTSO. - */ -void scavengeTSOIOManager(StgTSO *tso); - - /* Several code paths are almost identical between read and write paths. In * such cases we use a shared code path with an enum to say which we're doing. */ ===================================== rts/Messages.c ===================================== @@ -267,7 +267,8 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) // NB. we check to make sure that the owner is not the same as // the current thread, since in that case it will not be on // the run queue. - if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) { + if (RELAXED_LOAD(&owner->why_blocked) == NotBlocked && + owner->id != msg->tso->id) { promoteInRunQueue(cap, owner); } @@ -328,7 +329,8 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) msg->tso->id, owner->id); // See above, #3838 - if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) { + if (RELAXED_LOAD(&owner->why_blocked) == NotBlocked && + owner->id != msg->tso->id) { promoteInRunQueue(cap, owner); } ===================================== rts/PrimOps.cmm ===================================== @@ -1145,12 +1145,12 @@ stg_threadStatuszh ( gcptr tso ) // contents of block_info too, then we'd have to do some synchronisation. if (what_next == ThreadComplete) { - ret = 16; // NB. magic, matches up with GHC.Conc.threadStatus + ret = BlockedThreadComplete; // NB. magic, matches up with GHC.Conc.threadStatus } else { if (what_next == ThreadKilled) { - ret = 17; + ret = BlockedThreadKilled; } else { - ret = why_blocked; + ret = UntagWhyBlocked(why_blocked); } } @@ -2319,7 +2319,8 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); - %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32; + %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32 + | BlockInfoForceNonClosure::I32; ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr", CurrentTSO "ptr"); @@ -2339,7 +2340,8 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); - %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32; + %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32 + | BlockInfoForceNonClosure::I32; ccall appendToIOBlockedQueue(Capability_iomgr(MyCapability()) "ptr", CurrentTSO "ptr"); ===================================== rts/RaiseAsync.c ===================================== @@ -233,7 +233,6 @@ throwTo (Capability *cap, // the Capability we hold uint32_t throwToMsg (Capability *cap, MessageThrowTo *msg) { - StgWord status; StgTSO *target = ACQUIRE_LOAD(&msg->target); Capability *target_cap; @@ -268,9 +267,9 @@ check_target: return THROWTO_BLOCKED; } - status = ACQUIRE_LOAD(&target->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&target->why_blocked); - switch (status) { + switch (UntagWhyBlocked(why_blocked)) { case NotBlocked: { if ((target->flags & TSO_BLOCKEX) == 0) { @@ -370,8 +369,9 @@ check_target: // we have the MVar, let's check whether the thread // is still blocked on the same MVar. - if ((target->why_blocked != BlockedOnMVar - && target->why_blocked != BlockedOnMVarRead) + StgThreadWhyBlocked why_blocked_still = ACQUIRE_LOAD(&target->why_blocked); + if (( why_blocked_still != BlockedOnMVar + && why_blocked_still != BlockedOnMVarRead) || target->block_info.mvar != mvar) { unlockClosure((StgClosure *)mvar, info); goto retry; @@ -490,7 +490,7 @@ check_target: goto retry; default: - barf("throwTo: unrecognised why_blocked (%d)", target->why_blocked); + barf("throwTo: unrecognised why_blocked (%d)", why_blocked); } barf("throwTo"); } @@ -667,7 +667,7 @@ removeFromMVarBlockedQueue (StgTSO *tso) static void removeFromQueues(Capability *cap, StgTSO *tso) { - switch (tso->why_blocked) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case NotBlocked: case ThreadMigrating: @@ -721,8 +721,8 @@ removeFromQueues(Capability *cap, StgTSO *tso) } done: - RELAXED_STORE(&tso->why_blocked, NotBlocked); appendToRunQueue(cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } /* ----------------------------------------------------------------------------- @@ -1105,9 +1105,9 @@ done: IF_DEBUG(sanity, checkTSO(tso)); // wake it up - if (tso->why_blocked != NotBlocked) { - tso->why_blocked = NotBlocked; + if (RELAXED_LOAD(&tso->why_blocked) != NotBlocked) { appendToRunQueue(cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } return tso; ===================================== rts/RaiseAsync.h ===================================== @@ -56,7 +56,7 @@ void awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso); INLINE_HEADER int interruptible(StgTSO *t) { - switch (t->why_blocked) { + switch (UntagWhyBlocked(t->why_blocked)) { case BlockedOnMVar: case BlockedOnSTM: case BlockedOnMVarRead: ===================================== rts/Schedule.c ===================================== @@ -181,7 +181,7 @@ static void truncateRunQueue(Capability *cap); static StgTSO *popRunQueue (Capability *cap); static inline EventThreadStatus eventlogThreadStatus(StgThreadReturnCode ret_code); -static inline EventThreadStatus eventlogThreadStatusBlocked(StgWord why_blocked); +static inline EventThreadStatus eventlogThreadStatusBlocked(StgThreadWhyBlocked why_blocked); /* --------------------------------------------------------------------------- Main scheduling loop. @@ -531,7 +531,7 @@ run_thread: #endif if (ret == ThreadBlocked) { - uint16_t why_blocked = ACQUIRE_LOAD(&t->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&t->why_blocked); EventThreadStatus status = eventlogThreadStatusBlocked(why_blocked); StgWord32 status_detail = 0; if (why_blocked == BlockedOnBlackHole) { @@ -1074,7 +1074,7 @@ schedulePostRunThread (Capability *cap, StgTSO *t) // // and a is never equal to b given a consistent view of memory. // - if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) { + if (t -> trec != NO_TREC && RELAXED_LOAD(&t->why_blocked) == NotBlocked) { if (!stmValidateNestOfTransactions(cap, t -> trec, true)) { debugTrace(DEBUG_sched | DEBUG_stm, "trec %p found wasting its time", t); @@ -2508,9 +2508,9 @@ suspendThread (StgRegTable *reg, bool interruptible) tso->block_info.unused = END_TSO_QUEUE; if (interruptible) { - tso->why_blocked = BlockedOnCCall_Interruptible; + RELEASE_STORE(&tso->why_blocked, BlockedOnCCall_Interruptible); } else { - tso->why_blocked = BlockedOnCCall; + RELEASE_STORE(&tso->why_blocked, BlockedOnCCall); } // Hand back capability @@ -2568,16 +2568,25 @@ resumeThread (void *task_) tso = incall->suspended_tso; incall->suspended_tso = NULL; incall->suspended_cap = NULL; + + // we set why_blocked previously in suspendThread + ASSERT(tso->why_blocked == BlockedOnCCall || + tso->why_blocked == BlockedOnCCall_Interruptible); + // we will modify tso->_link IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(cap, (StgClosure *)tso->_link); } tso->_link = END_TSO_QUEUE; + // but no need to modify tso->block_info.prev as coincidentally + // it has the value we want already (since in suspendThread we set + // tso->block_info.unused to END_TSO_QUEUE for BlockedOnCCall). + ASSERT(tso->block_info.prev == END_TSO_QUEUE); traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + RELEASE_STORE(&tso->why_blocked, NotBlocked); if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to @@ -2950,8 +2959,9 @@ deleteThread (StgTSO *tso) // The TSO must be on the run queue of the Capability we own, or // we must own all Capabilities. - if (tso->why_blocked != BlockedOnCCall && - tso->why_blocked != BlockedOnCCall_Interruptible) { + StgThreadWhyBlocked why_blocked = RELAXED_LOAD(&tso->why_blocked); + if (why_blocked != BlockedOnCCall && + why_blocked != BlockedOnCCall_Interruptible) { throwToSingleThreaded(tso->cap,tso,NULL); } } @@ -2962,10 +2972,12 @@ deleteThread_(StgTSO *tso) { // for forkProcess only: // like deleteThread(), but we delete threads in foreign calls, too. - if (tso->why_blocked == BlockedOnCCall || - tso->why_blocked == BlockedOnCCall_Interruptible) { + StgThreadWhyBlocked why_blocked = RELAXED_LOAD(&tso->why_blocked); + if (why_blocked == BlockedOnCCall || + why_blocked == BlockedOnCCall_Interruptible) { tso->what_next = ThreadKilled; appendToRunQueue(tso->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } else { deleteThread(tso); } @@ -3355,7 +3367,7 @@ resurrectThreads (StgTSO *threads) // Wake up the thread on the Capability it was last on cap = tso->cap; - switch (tso->why_blocked) { + switch (UntagWhyBlocked(RELAXED_LOAD(&tso->why_blocked))) { case BlockedOnMVar: case BlockedOnMVarRead: /* Called by GC - sched_mutex lock is currently held. */ @@ -3427,7 +3439,7 @@ static inline EventThreadStatus eventlogThreadStatus(StgThreadReturnCode ret_cod return thread_stop_code[ret_code]; } -static inline EventThreadStatus eventlogThreadStatusBlocked(StgWord why_blocked) +static inline EventThreadStatus eventlogThreadStatusBlocked(StgThreadWhyBlocked why_blocked) { - return thread_blocked_code[why_blocked]; + return thread_blocked_code[UntagWhyBlocked(why_blocked)]; } ===================================== rts/Threads.c ===================================== @@ -291,7 +291,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso) } #endif - switch (ACQUIRE_LOAD(&tso->why_blocked)) + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnMVar: case BlockedOnMVarRead: @@ -335,8 +335,8 @@ tryWakeupThread (Capability *cap, StgTSO *tso) unblock: // just run the thread now, if the BH is not really available, // we'll block again. - tso->why_blocked = NotBlocked; appendToRunQueue(cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); // We used to set the context switch flag here, which would // trigger a context switch a short time in the future (at the end @@ -368,7 +368,7 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to) // ThreadMigrating tells the target cap that it needs to be added to // the run queue when it receives the MSG_TRY_WAKEUP. tso->block_info.unused = END_TSO_QUEUE; - tso->why_blocked = ThreadMigrating; + RELEASE_STORE(&tso->why_blocked, ThreadMigrating); tso->cap = to; tryWakeupThread(from, tso); } @@ -876,7 +876,7 @@ loop: // save why_blocked here, because waking up the thread destroys // this information - StgWord why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); ASSERT(why_blocked == BlockedOnMVarRead || why_blocked == BlockedOnMVar); ASSERT(tso->block_info.mvar == mvar); @@ -949,7 +949,7 @@ end: void printThreadBlockage(StgTSO *tso) { - switch (ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { #if defined(mingw32_HOST_OS) case BlockedOnDoProc: debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID); @@ -1046,7 +1046,7 @@ printAllThreads(void) debugBelch("other threads:\n"); for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (t = generations[g].threads; t != END_TSO_QUEUE; t = next) { - if (t->why_blocked != NotBlocked) { + if (RELAXED_LOAD(&t->why_blocked) != NotBlocked) { printThreadStatus(t); } next = t->global_link; ===================================== rts/TraverseHeap.c ===================================== @@ -1242,15 +1242,12 @@ inner_loop: traversePushClosure(ts, (StgClosure *) tso->blocked_exceptions, c, sep, child_data); traversePushClosure(ts, (StgClosure *) tso->bq, c, sep, child_data); traversePushClosure(ts, (StgClosure *) tso->trec, c, sep, child_data); - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: + + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + if (IsBlockInfoClosure(why_blocked) && why_blocked != NotBlocked) { + // The NotBlocked case uses block_info.prev as a TSO back link. + // Do not follow in that case or we'll get into a loop. traversePushClosure(ts, tso->block_info.closure, c, sep, child_data); - break; - default: - break; } goto loop; } ===================================== rts/include/rts/Constants.h ===================================== @@ -253,6 +253,33 @@ * block_info union. The comment for each tag below says which member * of the block_info union is used. * + * We also use the why_blocked to determine if the block_info contains + * a closure or not. There are three classes of tag: + * 1. why_blocked tags where block_info is always a closure; + * 2. why_blocked tags where block_info is never a closure; + * 3. why_blocked tags where block_info is sometimes a closure; + * + * We use the following encoding scheme for the three classes above: + * 1. the tag value has bits 3 and 4 unset (values 0..7); + * 2. the tag value has bit 3 set (values 8..15); and + * 3. the tag value has bit 4 set when it is not a closure and unset + * when it is a closure. + * + * This scheme makes it cheap and simple to check if the GC needs to + * look at the block_info.closure. + * + * The reason for the encoding using 2 marker bits rather than 1 is + * that it minimises the cases in the code that need to use or check + * the tag bits. The only tags in class 3 are BlockedOn{Read,Write + * Delay} which are used by in-RTS I/O managers, and the only ones that + * need to use block_info members that are not a closure are the legacy + * I/O managers select and win32-legacy. So when these I/O managers are + * removed then we can simplify the encoding. + */ +#define BlockInfoForceNonClosure 16 +#define UntagWhyBlocked(why) ((why) & 15) +#define IsBlockInfoClosure(why) (((why) & 24) == 0) +/* * In the threaded RTS there is an invariant that the block_info union * is always a valid GC closure. To ensure this, the tags that use * block_info.unused, always set it to END_TSO_QUEUE. The non-closure @@ -269,21 +296,31 @@ #define BlockedOnMVarRead 2 /* Uses block_info.mvar */ #define BlockedOnBlackHole 3 /* Uses block_info.bh */ #define BlockedOnMsgThrowTo 4 /* Uses block_info.throwto */ -#define BlockedOnRead 5 /* Uses block_info.aiop or uses .fd or - .async_result */ -#define BlockedOnWrite 6 /* Uses block_info.aiop or uses .fd or - .async_result */ -#define BlockedOnDelay 7 /* Uses block_info.timeout or +#define BlockedOnRead 5 /* Uses block_info.aiop + or with BlockInfoForceNonClosure + uses .fd or .async_reqID */ +#define BlockedOnWrite 6 /* Uses block_info.aiop + or with BlockInfoForceNonClosure + uses .fd or .async_reqID */ +#define BlockedOnDelay 7 /* Uses block_info.timeout + or with BlockInfoForceNonClosure uses .target */ #define BlockedOnSTM 8 /* Uses block_info.unused */ #define BlockedOnCCall 9 /* Uses block_info.unused */ #define BlockedOnCCall_Interruptible 10 /* Uses block_info.unused - * Same as BlockedOnCCall but permits - * killing the worker thread */ + * Same as BlockedOnCCall but permits + * killing the worker thread */ #define ThreadMigrating 11 /* Uses block_info.unused */ -#define BlockedOnDoProc 12 /* Uses block_info.async_result - * used by win32-legacy I/O manager */ +#define BlockedOnDoProc 12 /* Uses block_info.async_reqID */ + +/* Reserved values, not values that why_blocked currently use. They + * are used in primop stg_threadStatuszh and must not overlap with + * other why_blocked status values. They could be changed, if the + * threadStatus in ghc-internal is updated too. + */ +#define BlockedThreadComplete 16 +#define BlockedThreadKilled 17 /* Next available non-closure why_blocked tag numbers are: 13,14,15 * For more closure tag numbers, shift up all the non-closure ones ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -30,6 +30,15 @@ typedef StgWord64 StgThreadID; #define tsoLocked(tso) ((tso)->flags & TSO_LOCKED) +/* Type for the tso->why_blocked field. See values in Constants.h. + * + * The StgThreadWhyBlocked type could be 8-bits, but for reasons + * unclear it is currently 32-bits. Previous comments here claimed + * that the smallest atomic type on AArch64 is 32-bits, but this is + * false. + */ +typedef StgWord32 StgThreadWhyBlocked; + /* * Type returned after running a thread. Values of this type * include HeapOverflow, StackOverflow etc. See Constants.h for the @@ -98,7 +107,21 @@ typedef union { * have the reason in the why_blocked field of the TSO, and some * further info (such as the closure the thread is blocked on, or the * file descriptor if the thread is waiting on I/O) in the block_info - * field. + * field. See Constants.h for the why_blocked values. + * + * The why_blocked field must be updated atomically. The protocol for + * updating block_info and why_blocked fields together is as follows: + * + * Writes: + * - first write block_info (normal non-atomic write) + * - then write why_blocked with an atomic *store release* + * + * Reads: + * - first read why_blocked with an atomic *load acquire* + * - then read block_info (normal non-atomic read) + * + * Read of only why_blocked without block_info: + * - read why_blocked with an atomic *relaxed load* */ typedef struct StgTSO_ { @@ -148,11 +171,7 @@ typedef struct StgTSO_ { StgWord16 what_next; // Values defined in Constants.h StgWord32 flags; // Values defined in Constants.h - /* - * N.B. why_blocked only has a handful of values but must be atomically - * updated; the smallest width which AArch64 supports for is 32-bits. - */ - StgWord32 why_blocked; // Values defined in Constants.h + StgThreadWhyBlocked why_blocked; // Values defined in Constants.h StgTSOBlockInfo block_info; // Barrier provided by why_blocked StgThreadID id; StgWord32 saved_errno; ===================================== rts/posix/Poll.c ===================================== @@ -183,8 +183,9 @@ bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, aiop->notify.tso = tso; aiop->notify_type = NotifyTSO; aiop->live = &stg_ASYNCIO_LIVE0_closure; - tso->why_blocked = rw == IORead ? BlockedOnRead : BlockedOnWrite; tso->block_info.aiop = aiop; + RELEASE_STORE(&tso->why_blocked, rw == IORead ? BlockedOnRead + : BlockedOnWrite); return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd); } @@ -299,10 +300,9 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) * cap because the tso was not on the run queue of any cap and * so is not subject to thread migration. */ - StgTSO *tso = aiop->notify.tso; - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; + StgTSO *tso = aiop->notify.tso; pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); } /* For the TSO case, the aiop was only reachable from the TSO * itself, and thus it is now no longer be reachable at all. ===================================== rts/posix/Select.c ===================================== @@ -138,11 +138,10 @@ static bool wakeUpSleepingThreads (CapIOManager *iomgr, LowResTime now) break; } iomgr->sleeping_queue = tso->_link; - RELAXED_STORE(&tso->why_blocked, NotBlocked); - tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); flag = true; } return flag; @@ -311,7 +310,7 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) * So the (int) cast should be removed across the code base once * GHC requires a version of FreeBSD that has that change in it. */ - switch (ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: { int fd = tso->block_info.fd; @@ -449,7 +448,7 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) int fd; enum FdState fd_state = RTS_FD_IS_BLOCKING; - switch (tso->why_blocked) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: fd = tso->block_info.fd; @@ -488,9 +487,8 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) IF_DEBUG(scheduler, debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; case RTS_FD_IS_BLOCKING: if (prev == NULL) ===================================== rts/posix/Timeout.c ===================================== @@ -48,8 +48,8 @@ bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) initElemTimeoutQueue(timeout, notify, NotifyTSO, iomgr->cap->r.rCCCS); ASSERT(tso->why_blocked == NotBlocked); - tso->why_blocked = BlockedOnDelay; tso->block_info.timeout = timeout; + RELEASE_STORE(&tso->why_blocked, BlockedOnDelay); insertTimeoutQueue(&iomgr->timeout_queue, timeout, target); @@ -116,10 +116,9 @@ static void notifyTimeoutCompletion(CapIOManager *iomgr, StgTimeout *timeout) switch (timeout->notify_type) { case NotifyTSO: { - StgTSO *tso = timeout->notify.tso; - tso->why_blocked = NotBlocked; - tso->_link = END_TSO_QUEUE; + StgTSO *tso = timeout->notify.tso; pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; } case NotifyMVar: ===================================== rts/sm/Compact.c ===================================== @@ -468,16 +468,10 @@ thread_TSO (StgTSO *tso) thread_(&tso->_link); thread_(&tso->global_link); - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { + /* This also follows the block_info.prev back-link in + * the NotBlocked case, which may not be necessary. */ thread_(&tso->block_info.closure); - break; - default: - break; } thread_(&tso->blocked_exceptions); thread_(&tso->bq); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -1055,16 +1055,10 @@ trace_tso (MarkQueue *queue, StgTSO *tso) if (tso->label != NULL) { markQueuePushClosure_(queue, (StgClosure *) tso->label); } - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { + /* This also follows the block_info.prev back-link in + * the NotBlocked case, which may not be necessary. */ markQueuePushClosure_(queue, tso->block_info.closure); - break; - default: - break; } } ===================================== rts/sm/Sanity.c ===================================== @@ -779,13 +779,45 @@ checkTSO(StgTSO *tso) info == &stg_WHITEHOLE_info); // used to happen due to STM doing // lockTSO(), might not happen now - if ( tso->why_blocked == BlockedOnMVar - || tso->why_blocked == BlockedOnMVarRead - || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnMsgThrowTo - || tso->why_blocked == NotBlocked - ) { + StgThreadWhyBlocked why_blocked = ACQUIRE_LOAD(&tso->why_blocked); + switch (why_blocked) { + case NotBlocked: + case BlockedOnMVar: + case BlockedOnMVarRead: + case BlockedOnBlackHole: + case BlockedOnMsgThrowTo: + case BlockedOnRead: + case BlockedOnWrite: + case BlockedOnDelay: + //TODO: we could be more specific and check BlockedOnMVar has an MVar, + // BlockedOnBlackHole has a message, BlockedOnRead has an AIOP etc. + ASSERT(IsBlockInfoClosure(why_blocked)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + break; + + case BlockedOnSTM: + case BlockedOnCCall: + case BlockedOnCCall_Interruptible: + case ThreadMigrating: + ASSERT(!IsBlockInfoClosure(why_blocked)); + ASSERT(tso->block_info.unused == END_TSO_QUEUE); + break; + +#if !defined(THREADED_RTS) + // Only these three can use BlockInfoForceNonClosure + case BlockedOnRead | BlockInfoForceNonClosure: + case BlockedOnWrite | BlockInfoForceNonClosure: + case BlockedOnDelay | BlockInfoForceNonClosure: +#if defined(mingw32_HOST_OS) + case BlockedOnDoProc: +#endif + ASSERT(!IsBlockInfoClosure(why_blocked)); + break; +#endif + + default: + barf("checkTSO: strange tso->why_blocked: %d for TSO %" + FMT_StgThreadID " (%p)", why_blocked, tso->id, tso); } ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ===================================== rts/sm/Scav.c ===================================== @@ -138,21 +138,9 @@ scavengeTSO (StgTSO *tso) evacuate((StgClosure **)&tso->label); } - switch (ACQUIRE_LOAD(&tso->why_blocked)) { - case BlockedOnMVar: - case BlockedOnMVarRead: - case BlockedOnBlackHole: - case BlockedOnMsgThrowTo: - case NotBlocked: + if (IsBlockInfoClosure(ACQUIRE_LOAD(&tso->why_blocked))) { evacuate(&tso->block_info.closure); - break; - case BlockedOnRead: - case BlockedOnWrite: - case BlockedOnDelay: - case BlockedOnDoProc: - scavengeTSOIOManager(tso); - break; - default: + } else { #if defined(THREADED_RTS) // in the THREADED_RTS, block_info.closure must always point to a // valid closure, because we assume this in throwTo(). In the @@ -160,7 +148,6 @@ scavengeTSO (StgTSO *tso) // BlockedOnRead/BlockedOnWrite) or a time value (BlockedOnDelay) ASSERT(tso->block_info.unused == END_TSO_QUEUE); #endif - break; } tso->dirty = gct->failed_to_evac; ===================================== rts/win32/AsyncMIO.c ===================================== @@ -304,7 +304,7 @@ start: for(tso = iomgr->blocked_queue_hd; tso != END_TSO_QUEUE; tso = tso->_link) { - switch(ACQUIRE_LOAD(&tso->why_blocked)) { + switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { case BlockedOnRead: case BlockedOnWrite: case BlockedOnDoProc: @@ -324,8 +324,6 @@ start: } // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // For stg_block_async frames (read/write/doProc), // write len and errCode directly to the stack. // For stg_block_noregs frames (delay), nothing @@ -335,14 +333,14 @@ start: tso->stackobj->sp[2] = (W_)errCode; } pushOnRunQueue(&MainCapability, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; } break; - default: - if (tso->why_blocked != NotBlocked) { - barf("awaitRequests: odd thread state"); - } + case NotBlocked: break; + default: + barf("awaitRequests: odd thread state"); } prev = tso; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e76e9134ad3e6dcff1193bcf1979a2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e76e9134ad3e6dcff1193bcf1979a2… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 3 commits: Introduce global unit database cache
by Hannes Siebenhandl (＠fendor) 21 Jul '26

21 Jul '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 88532fed by fendor at 2026-07-21T10:54:21+02:00 Introduce global unit database cache As a first step for better sharing of `UnitInfo` across `UnitEnv`, we introduce a new datatype called `ExternalUnitDatabases`. It primarily serves as an in-memory representation of *all* `UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s depend on the same database, one way or another, we make sure that we don't parse from disk every time. Instead, we store the in-memory representation in `ExternalUnitDatabases`. `ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`. The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make sure we don't parse the same unit database multiple times. Almost by accident, we change the semantics of `initUnits` to honour modifications to `packageDBFlags`. The inability to change `packageDBFlags` while also reusing the already parsed `UnitDatabase`s was reported in #26423 as a bug. Hence, we think this behaviour change is warranted and acceptable, especially since it comes with a breaking change to the `initUnits` API. Add regression test for #26423 Closes #26423 - - - - - 72d78bf1 by fendor at 2026-07-21T10:54:21+02:00 Introduce UnitIndex for global external unit caching `UnitInfo`s have been observed to cause a lot of memory usage in #27500. Especially with multiple home units, as the same (external) units are processed from scratch, even though most of the time we end up with exactly the same `UnitInfo`. We introduce a `UnitEnv` global cache that allows us to store external unit information that is used across all `HomeUnitEnv`s. The most important change in this commit is the introduction of the `UnitIndex`. It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits` always uses the cached `UnitInfo` entry to populate each `HomeUnitEnv`'s `UnitState`. This allows us to ensure the following property: > Each `UnitInfo` should be alive exactly once in GHC. In addition, the `ExternalUnitDatabaseCache` may also hold a reference to each on-disk representation of `UnitInfo`. This means, we impose an hard upper bound on the number of `UnitInfo`s alive in the GHC session: > The number of alive `UnitInfo`s closure objects must be the > sum of all loaded unit database times two. We add performance regression tests that make sure the number of live `UnitInfo` cannot exceed this threshold. Closes #27500 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiComponentModulesRecomp100 mhu-perf ------------------------- These metrics increases are especially notable, as we are not even sharing anything big but merely the global package database with 50 entries. It shows how careful sharing of `UnitInfo` can improve memory usage. We expect this to be much more notable when the whole cabal package database is shared across multiple home units. --- Technical details To share the `UnitInfo`s correctly, it is important that we extract the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap` must be globally the same for all `HomeUnitEnv`s. This is important, as we could otherwise not cache the "fully-resolved" `UnitInfo`. We consider a `UnitInfo` fully-resolved, if wired-in units have been updated, the `UnitInfo` has been validated and variables in the unit config, such as `${pkgroot}` have been resolved. Updating the wired-in units requires the `WireMap` to be globally the same. - - - - - d4247f65 by fendor at 2026-07-21T13:54:05+02:00 Add test for multiple home units to show that the number of UnitInfo's doesn't increase - - - - - 45 changed files: - + changelog.d/T26423 - + changelog.d/unit-index - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - + compiler/GHC/Unit/External/Index.hs - + compiler/GHC/Unit/External/ModuleOrigin.hs - + compiler/GHC/Unit/External/Providers.hs - + compiler/GHC/Unit/External/Query.hs - + compiler/GHC/Unit/External/Substitution.hs - + compiler/GHC/Unit/External/Validate.hs - + compiler/GHC/Unit/External/Visibility.hs - + compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/State.hs-boot - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/T26423/Hello.hs - + testsuite/tests/driver/T26423/Makefile - + testsuite/tests/driver/T26423/T26423.hs - + testsuite/tests/driver/T26423/T26423.stderr - + testsuite/tests/driver/T26423/T26423.stdout - + testsuite/tests/driver/T26423/all.T - + testsuite/tests/driver/T26423/test/Test.hs - + testsuite/tests/driver/T26423/test/test.pkg - + testsuite/tests/driver/TUnitInfo/Foo.hs - + testsuite/tests/driver/TUnitInfo/Makefile - + testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout - utils/haddock/haddock-api/src/Haddock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0643509a33164e67501c52e2f6a3ef… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0643509a33164e67501c52e2f6a3ef… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/9.14.2-backports] 4 commits: compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Zubin (＠wz1000) 21 Jul '26

21 Jul '26

Zubin pushed to branch wip/9.14.2-backports at Glasgow Haskell Compiler / GHC Commits: 0fc947c2 by mangoiv at 2026-07-21T16:18:11+05:30 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. It also exports the type from ghc-internal:GHC.Internal.Types in order to expose documentation. Fixes #27390 Co-Authored-By: Sam Derbyshire <sam.derbyshire(a)gmail.com> (cherry picked from commit a72ff58fa86172b1557e405f7246d27914fdae6e) - - - - - d9d9a27c by Zubin Duggal at 2026-07-21T16:18:11+05:30 hadrian: Remove old package.conf files when generating new ones Old package.conf files might exists with different hashes, causing issues like #26661 Fixes #26661 (cherry picked from commit 5ac9ce7d3821c75e2d2cc17fae00b9e865a02987) - - - - - 576e3a03 by Zubin Duggal at 2026-07-21T16:18:11+05:30 testsuite: disable git auto-gc when fetching perf notes Otherwise the message it prints breaks the parsing - - - - - d0cd71ee by Zubin Duggal at 2026-07-21T16:18:11+05:30 Prepare 9.14.2 Bump filpath submodule to 1.5.5.0 Bump Win32 submodule to 2.14.2.2 Metric Increase: T4029 T13379 Metric Decrease: T5030 - - - - - 65 changed files: - − changelog.d/26616 - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27386 - − changelog.d/bump-process - − changelog.d/deterministic-usage-order - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/jobserver-leak-fix - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - configure.ac - docs/users_guide/9.14.2-notes.rst - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - libraries/Win32 - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/filepath - libraries/ghc-experimental/src/GHC/PrimOps.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/driver/perf_notes.py - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/linters/notes.stdout - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/typecheck/should_fail/T13292.stderr - + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr - + testsuite/tests/typecheck/should_fail/T27390.hs - + testsuite/tests/typecheck/should_fail/T27390.stderr - + testsuite/tests/typecheck/should_fail/T27390a.hs - testsuite/tests/typecheck/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b8c5e3b2c0b96df4c36b24ceca40e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b8c5e3b2c0b96df4c36b24ceca40e… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/9.14.2-backports] 5 commits: compiler: refactor error reporting code for ExplicitLevelImports
by Zubin (＠wz1000) 21 Jul '26

21 Jul '26

Zubin pushed to branch wip/9.14.2-backports at Glasgow Haskell Compiler / GHC Commits: 521e1527 by mangoiv at 2026-07-21T15:59:23+05:30 compiler: refactor error reporting code for ExplicitLevelImports Refactors error reporting code for ExplicitLevelImports to pass in a RdrName and a GlobalReaderElt to be able to report errors that are faithful to the source and to more precisely distinguish between names that are in scope from different qualifications. Fixes #27385 and #26616 (cherry picked from commit 141986e3680a24b76e21a7ad4ce6290a7413c7f5) - - - - - fd9cf61a by mangoiv at 2026-07-21T15:59:23+05:30 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. It also exports the type from ghc-internal:GHC.Internal.Types in order to expose documentation. Fixes #27390 Co-Authored-By: Sam Derbyshire <sam.derbyshire(a)gmail.com> (cherry picked from commit a72ff58fa86172b1557e405f7246d27914fdae6e) - - - - - 9107103d by Zubin Duggal at 2026-07-21T15:59:23+05:30 hadrian: Remove old package.conf files when generating new ones Old package.conf files might exists with different hashes, causing issues like #26661 Fixes #26661 (cherry picked from commit 5ac9ce7d3821c75e2d2cc17fae00b9e865a02987) - - - - - b8c4e605 by Zubin Duggal at 2026-07-21T15:59:23+05:30 testsuite: disable git auto-gc when fetching perf notes Otherwise the message it prints breaks the parsing - - - - - 7b8c5e3b by Zubin Duggal at 2026-07-21T15:59:23+05:30 Prepare 9.14.2 Bump filpath submodule to 1.5.5.0 Bump Win32 submodule to 2.14.2.2 Metric Increase: T4029 T13379 Metric Decrease: T5030 - - - - - 125 changed files: - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27386 - − changelog.d/bump-process - − changelog.d/deterministic-usage-order - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/jobserver-leak-fix - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Name/Reader.hs - configure.ac - docs/users_guide/9.14.2-notes.rst - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - libraries/Win32 - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/filepath - libraries/ghc-experimental/src/GHC/PrimOps.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/driver/perf_notes.py - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail04.stderr - testsuite/tests/annotations/should_fail/annfail06.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - testsuite/tests/quotes/LiftErrMsg.stderr - testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/T5721.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI08.stderr - testsuite/tests/splice-imports/SI08_oneshot.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI29.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/splice-imports/SI36.stderr - testsuite/tests/splice-imports/T26088.stderr - testsuite/tests/splice-imports/T26090.stderr - + testsuite/tests/splice-imports/T26616.hs - + testsuite/tests/splice-imports/T26616.stderr - testsuite/tests/splice-imports/all.T - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T21547.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T23829_tardy.ghc.stderr - testsuite/tests/th/T26098_local.stderr - testsuite/tests/th/T26098_quote.stderr - testsuite/tests/th/T26098_splice.stderr - testsuite/tests/th/T26099.stderr - testsuite/tests/th/T26568.stderr - testsuite/tests/th/T5795.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr - + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr - + testsuite/tests/typecheck/should_fail/T27390.hs - + testsuite/tests/typecheck/should_fail/T27390.stderr - + testsuite/tests/typecheck/should_fail/T27390a.hs - testsuite/tests/typecheck/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb884c083d08075561815c521c991f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb884c083d08075561815c521c991f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/9.14.2-backports] Prepare 9.14.2
by Zubin (＠wz1000) 21 Jul '26

21 Jul '26

Zubin pushed to branch wip/9.14.2-backports at Glasgow Haskell Compiler / GHC Commits: cb884c08 by Zubin Duggal at 2026-07-21T15:33:47+05:30 Prepare 9.14.2 Bump filpath submodule to 1.5.5.0 Bump Win32 submodule to 2.14.2.2 - - - - - 39 changed files: - − changelog.d/26616 - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27386 - − changelog.d/bump-process - − changelog.d/deterministic-usage-order - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/hadrian-stale-package-confs-26661 - − changelog.d/jobserver-leak-fix - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/unused-type - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - configure.ac - docs/users_guide/9.14.2-notes.rst - libraries/Win32 - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/filepath The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb884c083d08075561815c521c991f9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb884c083d08075561815c521c991f9… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/9.14.2-backports] Prepare 9.14.2
by Zubin (＠wz1000) 21 Jul '26

21 Jul '26

Zubin pushed to branch wip/9.14.2-backports at Glasgow Haskell Compiler / GHC Commits: f7bb964b by Zubin Duggal at 2026-07-21T15:29:35+05:30 Prepare 9.14.2 Bump filpath submodule to 1.5.5.0 Bump Win32 submodule to 2.14.2.2 - - - - - 38 changed files: - − changelog.d/26616 - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27386 - − changelog.d/bump-process - − changelog.d/deterministic-usage-order - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/hadrian-stale-package-confs-26661 - − changelog.d/jobserver-leak-fix - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/unused-type - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - docs/users_guide/9.14.2-notes.rst - libraries/Win32 - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/filepath The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7bb964bdcaaa434f1d808d52b5ff00… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7bb964bdcaaa434f1d808d52b5ff00… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] Mark test T27105 as fragile, citing issue #27522
by Marge Bot (＠marge-bot) 21 Jul '26

21 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bb3bf6f7 by Duncan Coutts at 2026-07-21T05:36:19-04:00 Mark test T27105 as fragile, citing issue #27522 Scheduler fairness is fine, except when it isn't. And it isn't on CI machines surprisingly often! See the issue for details. - - - - - 2 changed files: - testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T Changes: ===================================== testsuite/tests/concurrent/should_run/T27105.hs ===================================== @@ -12,15 +12,19 @@ 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 75% imperfection. --- Yes, 75%! On the CI machines we occasionally observe extraordinary levels --- of unfairness: nearly 60% in some cases. We don't want this to become a --- fragile test that is ignored, so we use an extreme bound. This should still --- catch gross breakage. +-- expect a balance between the two with no more than a 30% imperfection. -- --- 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 +-- Sadly we have had to mark this test as fragile. On the CI machines we +-- occasionally observe extraordinary levels of unfairness: over 80% in some +-- cases. Having this marked fragile is not ideal, but it's no good having +-- random failures. See issue #27522. +-- +-- People working on the RTS timers, scheduler or capability infrastructure +-- *ought* to check this test is not failing badly in a reproducible way. +-- Doing so should still catch gross breakage. This test _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 @@ -42,17 +46,16 @@ test worker = do 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 75% unfairness threshold. + -- to get less than 10% unfairness. And on most platforms it is enough, + -- but for a bit of robustness we use 30%. putMVar stop () count1 <- takeMVar res1 count2 <- takeMVar res2 let balance :: Double balance = abs ((fromIntegral count1 - fromIntegral count2) / fromIntegral count2) - when (balance > 0.75) $ do - putStrLn "Schedule fairness more than 75% tolerance:" + when (balance > 0.30) $ do + putStrLn "Schedule fairness more than 30% tolerance:" putStrLn $ "imperfection: " ++ show (balance * 100) ++ "%" putStrLn $ "work counts: " ++ show (count1, count2) exitFailure ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -326,9 +326,10 @@ test('T26341b' , when(arch('wasm32') or arch('javascript'), skip) , compile_and_run, ['-package process']) -# Scheduler (very rough) fairness +# Scheduler fairness test('T27105', [when(arch('wasm32'), skip), # same reason as T367_letnoescape + fragile(27522), run_timeout_multiplier(0.05)], # we expect this to run for ~2s compile_and_run, ['']) test('T27105_fail', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb3bf6f7abd607e5cadf4f0005b0209… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb3bf6f7abd607e5cadf4f0005b0209… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0