Cheng Shao pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC Commits: b4b1720d by Ben Gamari at 2025-11-29T23:35:57+01:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. Also, introduce more strict checking of block_info in checkTSO. Co-authored-by: Cheng Shao <terrorjack@type.dance> - - - - - 9 changed files: - rts/RaiseAsync.c - rts/Schedule.c - rts/Threads.c - rts/include/rts/storage/TSO.h - rts/posix/Poll.c - rts/posix/Select.c - rts/posix/Timeout.c - rts/sm/Sanity.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -716,12 +716,13 @@ removeFromQueues(Capability *cap, StgTSO *tso) syncDelayCancel(cap, tso); goto done; - default: + default: barf("removeFromQueues: %d", tso->why_blocked); } done: RELAXED_STORE(&tso->why_blocked, NotBlocked); + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1087,6 +1088,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/Schedule.c ===================================== @@ -2589,7 +2589,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -338,6 +338,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -297,8 +297,8 @@ void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target); void dirty_STACK (Capability *cap, StgStack *stack); /* ----------------------------------------------------------------------------- - Invariants: - + Note [TSO invariants] + ~~~~~~~~~~~~~~~~~~~~~ An active thread has the following properties: tso->stack < tso->sp < tso->stack+tso->stack_size @@ -313,7 +313,8 @@ void dirty_STACK (Capability *cap, StgStack *stack); tso->why_blocked tso->block_info location ---------------------------------------------------------------------- - NotBlocked END_TSO_QUEUE runnable_queue, or running + NotBlocked END_TSO_QUEUE running + NotBlocked prev TSO runnable_queue (block_info.prev back-link) BlockedOnBlackHole MessageBlackHole * TSO->bq ===================================== rts/posix/Poll.c ===================================== @@ -261,6 +261,7 @@ static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop) */ StgTSO *tso = aiop->notify.tso; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap, tso); } ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; RELAXED_STORE(&tso->why_blocked, NotBlocked); + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/posix/Timeout.c ===================================== @@ -122,6 +122,7 @@ static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout) { StgTSO *tso = timeout->notify.tso; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap, tso); break; @@ -226,4 +227,3 @@ struct timespec *timeoutInNanoseconds(CapIOManager *iomgr, bool wait, #endif #endif // defined(IOMGR_ENABLED_POLL) - ===================================== rts/sm/Sanity.c ===================================== @@ -767,7 +767,6 @@ checkSTACK (StgStack *stack) * * See #19146. */ - void checkTSO(StgTSO *tso) { @@ -788,6 +787,14 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); } + /* See Note [TSO invariants] in TSO.h */ + if (tso->why_blocked == NotBlocked) { + // When on a run queue we use block_info.prev as the back-link. + // Otherwise (running) we expect END_TSO_QUEUE. + ASSERT(tso->block_info.closure == (StgClosure *)END_TSO_QUEUE || + get_itbl(tso->block_info.closure)->type == TSO); + } + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -319,14 +319,16 @@ start: : END_TSO_QUEUE; } - // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // save the StgAsyncIOResult in the // stg_block_async_info stack frame, because // the block_info field will be overwritten by // pushOnRunQueue(). tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + // Terminates the run queue + this inner for-loop. + tso->_link = END_TSO_QUEUE; pushOnRunQueue(&MainCapability, tso); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1720da1fb6e7792dc7779f3d02ad1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1720da1fb6e7792dc7779f3d02ad1... You're receiving this email because of your account on gitlab.haskell.org.