Ben Gamari pushed to branch wip/stm-mvar-deadlock-backtrace at Glasgow Haskell Compiler / GHC Commits: b60d32a5 by Ben Gamari at 2026-06-21T18:51:26-04:00 compiler: Report backtraces in MVar and STM deadlocks Apply the same treatment previously given to Nontermination exceptions to MVar and STM deadlock exceptions, using `throw` instead of ad-hoc throwing with `throwToSingleThread` to ensure that the usual backtrace machinery is involved. Related to #21877. - - - - - ed9e9669 by Ben Gamari at 2026-06-21T18:51:26-04:00 testsuite: Add tests for deadlock backtraces - - - - - 14 changed files: - changelog.d/builtin-exception-backtraces - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - rts/Prelude.h - rts/RaiseAsync.c - rts/RaiseAsync.h - rts/RtsStartup.c - rts/Schedule.c - rts/include/rts/RtsToHsIface.h - + testsuite/tests/rts/MVarDeadlockBacktrace.hs - + testsuite/tests/rts/MVarDeadlockBacktrace.stderr - + testsuite/tests/rts/STMDeadlockBacktrace.hs - + testsuite/tests/rts/STMDeadlockBacktrace.stderr - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/builtin-exception-backtraces ===================================== @@ -1,10 +1,10 @@ section: rts -synopsis: Non-termination exceptions now have backtrace annotations +synopsis: Non-termination and deadlock exceptions now have backtrace annotations issues: #21878 -mrs: !16158 +mrs: !16158 !16221 description: { - The `NonTermination` exception (manifesting in printed exception output as - `<<loop>>`) now include `Backtrace` `ExceptionAnnotations`, like exceptions - thrown from user-written Haskell. + The `BlockedOnMVar`, `BlockedOnSTM`, and `NonTermination` exceptions + (the latter being the infamous `<<loop>>` error) now include `Backtrace` + `ExceptionAnnotations`, like exceptions thrown from user-written Haskell. } ===================================== libraries/ghc-internal/include/RtsIfaceSymbols.h ===================================== @@ -15,8 +15,8 @@ CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure) CLOSURE(GHCziInternalziIOziException, stackOverflow_closure) CLOSURE(GHCziInternalziIOziException, heapOverflow_closure) CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure) -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure) -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure) +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVarError_closure) +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTMError_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure) ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs ===================================== @@ -24,8 +24,12 @@ ----------------------------------------------------------------------------- module GHC.Internal.IO.Exception ( - BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar, - BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM, + BlockedIndefinitelyOnMVar(..), + blockedIndefinitelyOnMVar, + blockedIndefinitelyOnMVarError, + BlockedIndefinitelyOnSTM(..), + blockedIndefinitelyOnSTM, + blockedIndefinitelyOnSTMError, Deadlock(..), AllocationLimitExceeded(..), allocationLimitExceeded, AssertionFailed(..), @@ -84,6 +88,9 @@ instance Exception BlockedIndefinitelyOnMVar instance Show BlockedIndefinitelyOnMVar where showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" +blockedIndefinitelyOnMVarError :: IO () -- for the RTS +blockedIndefinitelyOnMVarError = throwIO BlockedIndefinitelyOnMVar + blockedIndefinitelyOnMVar :: SomeException -- for the RTS blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar @@ -100,6 +107,9 @@ instance Exception BlockedIndefinitelyOnSTM instance Show BlockedIndefinitelyOnSTM where showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" +blockedIndefinitelyOnSTMError :: IO () -- for the RTS +blockedIndefinitelyOnSTMError = throwIO BlockedIndefinitelyOnSTM + blockedIndefinitelyOnSTM :: SomeException -- for the RTS blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM ===================================== rts/Prelude.h ===================================== @@ -53,8 +53,8 @@ extern StgClosure ZCMain_main_closure; #define stackOverflow_closure ghc_hs_iface->stackOverflow_closure #define heapOverflow_closure ghc_hs_iface->heapOverflow_closure #define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure -#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure -#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure +#define blockedIndefinitelyOnMVarError_closure ghc_hs_iface->blockedIndefinitelyOnMVarError_closure +#define blockedIndefinitelyOnSTMError_closure ghc_hs_iface->blockedIndefinitelyOnSTMError_closure #define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure #define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure #define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure ===================================== rts/RaiseAsync.c ===================================== @@ -87,6 +87,55 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here) throwToSingleThreaded__ (cap, tso, NULL, false, stop_here); } +/* ----------------------------------------------------------------------------- + scheduleRaiseViaIO + + Schedule `tso` to raise an exception by running `io_action`, an IO () that + performs `throwIO`. Unlike throwToSingleThreaded (which injects an exception + *value* via raiseAsync), the exception is raised by throwIO *within* the + thread, so it acquires a backtrace of the thread's stack. This is used by + resurrectThreads to deliver the "blocked indefinitely" exceptions + (BlockedIndefinitelyOnMVar, BlockedIndefinitelyOnSTM, NonTermination). + + We push a "run this IO action" frame on top of the thread's existing + (suspended) stack and make it runnable; when the thread runs, throwIO raises + the exception and its own stack unwinding handles any CATCH_FRAME / + ATOMICALLY_FRAME (e.g. aborting a blocked STM transaction). + + removeFromQueues takes care of unlinking the thread from any blocking queue + (notably the MVar blocked queue) and appends it to the run queue. As with + throwToSingleThreaded, the caller must own the TSO (e.g. hold all + capabilities during GC); in particular this relies on the thread not being + scheduled between removeFromQueues' enqueue and our stack push. + -------------------------------------------------------------------------- */ + +void +scheduleRaiseViaIO (Capability *cap, StgTSO *tso, StgClosure *io_action) +{ + // Thread already dead? + if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) { + return; + } + + // Unlink from any blocking queues; sets why_blocked = NotBlocked and + // appends the thread to the run queue. + removeFromQueues(cap, tso); + + StgStack *stack = tso->stackobj; + + // We are about to mutate the stack, so dirty it for the GC write barrier + // (resurrectThreads runs right after GC). + dirty_TSO(cap, tso); + dirty_STACK(cap, stack); + + // Push a frame that enters `io_action` and applies the resulting IO action + // to the void (RealWorld) argument: [stg_enter_info, io_action, stg_ap_v_info] + stack->sp -= 3; + stack->sp[0] = (W_)&stg_enter_info; + stack->sp[1] = (W_)io_action; + stack->sp[2] = (W_)&stg_ap_v_info; +} + /* ----------------------------------------------------------------------------- throwToSelf ===================================== rts/RaiseAsync.h ===================================== @@ -38,6 +38,10 @@ void suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here); +void scheduleRaiseViaIO (Capability *cap, + StgTSO *tso, + StgClosure *io_action); + MessageThrowTo *throwTo (Capability *cap, // the Capability we hold StgTSO *source, StgTSO *target, ===================================== rts/RtsStartup.c ===================================== @@ -192,9 +192,9 @@ static void initBuiltinGcRoots(void) getStablePtr((StgPtr)stackOverflow_closure); getStablePtr((StgPtr)heapOverflow_closure); getStablePtr((StgPtr)unpackCString_closure); - getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnMVarError_closure); getStablePtr((StgPtr)nonTerminationError_closure); - getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnSTMError_closure); getStablePtr((StgPtr)allocationLimitExceeded_closure); getStablePtr((StgPtr)cannotCompactFunction_closure); getStablePtr((StgPtr)cannotCompactPinned_closure); ===================================== rts/Schedule.c ===================================== @@ -3276,17 +3276,6 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso) } } -static void throwNontermination(Capability *cap, StgTSO *tso) { - StgStack *stack = tso->stackobj; - stack->sp -= 3; - stack->sp[0] = (W_)&stg_enter_info; - stack->sp[1] = (W_)nonTerminationError_closure; - stack->sp[2] = (W_)&stg_ap_v_info; - tso->why_blocked = NotBlocked; - appendToRunQueue(cap,tso); -} - - /* ----------------------------------------------------------------------------- resurrectThreads is called after garbage collection on the list of threads found to be garbage. Each of these threads will be woken @@ -3320,15 +3309,16 @@ resurrectThreads (StgTSO *threads) case BlockedOnMVar: case BlockedOnMVarRead: /* Called by GC - sched_mutex lock is currently held. */ - throwToSingleThreaded(cap, tso, - (StgClosure *)blockedIndefinitelyOnMVar_closure); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)blockedIndefinitelyOnMVarError_closure); break; case BlockedOnBlackHole: - throwNontermination(cap, tso); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)nonTerminationError_closure); break; case BlockedOnSTM: - throwToSingleThreaded(cap, tso, - (StgClosure *)blockedIndefinitelyOnSTM_closure); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)blockedIndefinitelyOnSTMError_closure); break; case NotBlocked: /* This might happen if the thread was blocked on a black hole ===================================== rts/include/rts/RtsToHsIface.h ===================================== @@ -20,8 +20,8 @@ typedef struct { StgClosure *stackOverflow_closure; // GHC.Internal.IO.Exception.stackOverflow_closure StgClosure *heapOverflow_closure; // GHC.Internal.IO.Exception.heapOverflow_closure StgClosure *allocationLimitExceeded_closure; // GHC.Internal.IO.Exception.allocationLimitExceeded_closure - StgClosure *blockedIndefinitelyOnMVar_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure - StgClosure *blockedIndefinitelyOnSTM_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure + StgClosure *blockedIndefinitelyOnMVarError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVarError_closure + StgClosure *blockedIndefinitelyOnSTMError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTMError_closure StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure ===================================== testsuite/tests/rts/MVarDeadlockBacktrace.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -finfo-table-map #-} + +-- | Check that a @BlockedIndefinitelyOnMVar@ deadlock exception carries a +-- backtrace mentioning the blocking site in this module. +import Control.Concurrent.MVar +import GHC.Exception.Backtrace.Experimental + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + mv <- newEmptyMVar :: IO (MVar ()) + x <- takeMVar mv + print x ===================================== testsuite/tests/rts/MVarDeadlockBacktrace.stderr ===================================== @@ -0,0 +1,2 @@ +MVarDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar: + Main.main (MVarDeadlockBacktrace.hs:16:3-36) ===================================== testsuite/tests/rts/STMDeadlockBacktrace.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -finfo-table-map #-} + +-- | Check that a @BlockedIndefinitelyOnSTM@ deadlock exception carries a +-- backtrace mentioning the blocking site in this module. +import GHC.Conc (atomically, retry) +import GHC.Exception.Backtrace.Experimental + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + x <- atomically retry :: IO () + print x ===================================== testsuite/tests/rts/STMDeadlockBacktrace.stderr ===================================== @@ -0,0 +1,2 @@ +STMDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM: + Main.main (STMDeadlockBacktrace.hs:16:3-32) ===================================== testsuite/tests/rts/all.T ===================================== @@ -689,3 +689,9 @@ test('ClosureTable', test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, ['']) test('LoopBacktrace', [exit_code(1)], compile_and_run, ['']) + +deadlock_backtrace_norm = grep_errmsg(r'(Uncaught exception|Main\.)') +test('MVarDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm], + compile_and_run, ['-O']) +test('STMDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm], + compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3f3e0a67ec3ddcfce84d2de133f952... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3f3e0a67ec3ddcfce84d2de133f952... You're receiving this email because of your account on gitlab.haskell.org.