GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

63ce5770

by Luite Stegeman at 2026-05-28T12:23:35-04:00

Fixes for black holes

 - suspend duplicate work for eager black holes
 - detect eager black holes in checkBlockingQueues
 - don't overwrite existing black holes even if they're not
     in an eager blackhole frame
 - don't deadlock on self when thunk is already blackholed

Fixes #26936

6 changed files:

+ changelog.d/fix-blackhole-handling
rts/Messages.c
rts/ThreadPaused.c
rts/Threads.c
rts/Updates.h
rts/include/rts/storage/ClosureMacros.h

Changes:

changelog.d/fix-blackhole-handling

 +section: rts
 +synopsis: Fix several black hole handling bugs that could lead to deadlocks
 +  or crashes in multithreaded programs. These could show up as the program
 +  hanging or "END_TSO_QUEUE object entered" errors.
 +issues: #26922 #26936
 +mrs: !15640

rts/Messages.c

@@ -188,10 +188,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
      // BLACKHOLE has already been updated, and GC has shorted out the
      // indirection, so the pointer no longer points to a BLACKHOLE at
      // all.
 -    if (bh_info != &stg_BLACKHOLE_info &&
 -        bh_info != &stg_CAF_BLACKHOLE_info &&
 -        bh_info != &__stg_EAGER_BLACKHOLE_info &&
 -        bh_info != &stg_WHITEHOLE_info) {
 +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(bh_info)) {
          return 0;
+     }
@@ -350,10 +347,7 @@ StgTSO * blackHoleOwner (StgClosure *bh)
      info = RELAXED_LOAD(&bh->header.info);
 -    if (info != &stg_BLACKHOLE_info &&
 -        info != &stg_CAF_BLACKHOLE_info &&
 -        info != &__stg_EAGER_BLACKHOLE_info &&
 -        info != &stg_WHITEHOLE_info) {
 +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(info)) {
          return NULL;
+     }

rts/ThreadPaused.c

@@ -183,6 +183,30 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
+     }
+ }
 +/*
 + * Check whether tso is the owner of the black hole bh.
 + *
 + * We must call this from the capability that runs tso,
 + * since that guarantees that the writes to bh->indirectee
 + * by tso claiming ownership have been visible. If another
 + * tso has claimed it again afterwards we can safely suspend
 + * our work.
 + */
 +static bool
 +threadPausedBlackHoleOwner(StgTSO *tso, StgClosure *bh)
 +{
 +    StgClosure *ind = RELAXED_LOAD(&((StgInd*)bh)->indirectee);
 +    if (ind == (StgClosure*)tso) {
 +        return true;
 +    }
 +    const StgInfoTable *ind_info = GET_INFO(UNTAG_CLOSURE(ind));
 +    if (ind_info == &stg_BLOCKING_QUEUE_CLEAN_info
 +        || ind_info == &stg_BLOCKING_QUEUE_DIRTY_info) {
 +        return ((StgBlockingQueue*)UNTAG_CLOSURE(ind))->owner == tso;
 +    }
 +    return false;
 +}
++
  /* -----------------------------------------------------------------------------
   * Pausing a thread
+  *
@@ -255,11 +279,10 @@ threadPaused(Capability *cap, StgTSO *tso)
              // Note [suspend duplicate work]
              // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              // If the info table is a WHITEHOLE or a BLACKHOLE, then
 -            // another thread has claimed it (via the SET_INFO()
 -            // below), or is in the process of doing so.  In that case
 -            // we want to suspend the work that the current thread has
 -            // done on this thunk and wait until the other thread has
 -            // finished.
 +            // some thread has claimed it, or is in the process of doing
 +            // so. In that case we want to suspend the work that the
 +            // current thread has done on this thunk and wait until the
 +            // other thread has finished.
              //
              // If eager blackholing is taking place, it could be the
              // case that the blackhole points to the current
@@ -287,8 +310,8 @@ threadPaused(Capability *cap, StgTSO *tso)
              // Note that great care is required when entering computations
              // suspended by this mechanism. See Note [AP_STACKs must be eagerly
              // blackholed] for details.
 -            if (((bh_info == &stg_BLACKHOLE_info)
 -                 && (RELAXED_LOAD(&((StgInd*)bh)->indirectee) != (StgClosure*)tso))
 +            if ((IS_BLACKHOLE_INFO(bh_info)
 +                && !threadPausedBlackHoleOwner(tso, bh))
                  || (bh_info == &stg_WHITEHOLE_info))
+             {
                  debugTrace(DEBUG_squeeze,
@@ -318,14 +341,13 @@ threadPaused(Capability *cap, StgTSO *tso)
              // If we have a frame that is already eagerly blackholed, we
              // shouldn't overwrite its payload: There may already be a blocking
              // queue (see #26324).
 -            if(frame_info == &stg_bh_upd_frame_info) {
 -                // eager black hole: we do nothing
 +            if(frame_info == &stg_bh_upd_frame_info
 +               || IS_BLACKHOLE_INFO(bh_info)) {
 +                // already a black hole: we do nothing
                  // it should be a black hole (but we may not own it, as another
                  // thread could have raced us to claim it)
 -                ASSERT(bh_info == &stg_BLACKHOLE_info ||
 -                       bh_info == &__stg_EAGER_BLACKHOLE_info ||
 -                       bh_info == &stg_CAF_BLACKHOLE_info);
 +                ASSERT(IS_BLACKHOLE_INFO(bh_info));
              } else {
                  // lazy black hole

rts/Threads.c

@@ -474,7 +474,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso)
          // thing the result would be the same in almost all cases. See #20093.
          p = UNTAG_CLOSURE(bq->bh);
          const StgInfoTable *pinfo = ACQUIRE_LOAD(&p->header.info);
 -        if (pinfo != &stg_BLACKHOLE_info ||
 +        if (!IS_BLACKHOLE_INFO(pinfo) ||
              (RELAXED_LOAD(&((StgInd *)p)->indirectee) != (StgClosure*)bq))
+         {
              wakeBlockingQueue(cap,bq);
@@ -498,10 +498,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val)
      const StgInfoTable *i;
      i = ACQUIRE_LOAD(&thunk->header.info);
 -    if (i != &stg_BLACKHOLE_info &&
 -        i != &stg_CAF_BLACKHOLE_info &&
 -        i != &__stg_EAGER_BLACKHOLE_info &&
 -        i != &stg_WHITEHOLE_info) {
 +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(i)) {
          updateWithIndirection(cap, thunk, val);
          return;
+     }

rts/Updates.h

@@ -190,9 +190,9 @@
   * frame is encountered, it checks the info table of the updatee and:
+  *
   *  - if it is `BLACKHOLE`, then the thunk has already been claimed for evaluation
 - *    by another thread, and the yielding thread is instead added to the
 - *    `BLACKHOLE`'s blocking queue (see Note [suspend duplicate work] in
 - *    `ThreadPaused.c`).
 + *    by some thread. If that's not the yielding thread itself, the yielding thread
 + *    is added to the `BLACKHOLE`'s blocking queue (see Note [suspend duplicate
 + *    work] in `ThreadPaused.c`).
+  *
   *  - if not, then it blackholes the thunk as done in eager blackholing (but
   *    using the `BLACKHOLE_info` info table instead of `EAGER_BLACKHOLE_info`).

rts/include/rts/storage/ClosureMacros.h

@@ -382,6 +382,18 @@ EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
  EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
  { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
 +/* -----------------------------------------------------------------------------
 +   Blackhole predicates
 +   -------------------------------------------------------------------------- */
++
 +#define IS_BLACKHOLE_INFO(info) \
 +    ((info) == &stg_BLACKHOLE_info || \
 +     (info) == &__stg_EAGER_BLACKHOLE_info || \
 +     (info) == &stg_CAF_BLACKHOLE_info)
++
 +#define IS_BLACKHOLE_OR_WHITEHOLE_INFO(info) \
 +    (IS_BLACKHOLE_INFO(info) || (info) == &stg_WHITEHOLE_info)
++
  /* --------------------------------------------------------------------------
     Sizes of closures
     ------------------------------------------------------------------------*/