Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • changelog.d/fix-blackhole-handling
    1 
    +section: rts
    2 
    +synopsis: Fix several black hole handling bugs that could lead to deadlocks
    3 
    +  or crashes in multithreaded programs. These could show up as the program
    4 
    +  hanging or "END_TSO_QUEUE object entered" errors.
    5 
    +issues: #26922 #26936
    6 
    +mrs: !15640

  • changelog.d/windows-rethrow-overlapped-exception
    1 
    +section: rts
    2 
    +synopsis: Rethrow exceptions in overlapped IO when using the WinIO IO manager.
    3 
    +issues: #27283
    4 
    +mrs: !15887
    5 
    +
    6 
    +description: {
    7 
    +  This change was made to support WinIO in the network library; see https://github.com/haskell/network/issues/602.
    8 
    +}

  • compiler/GHC/SysTools/Cpp.hs
    ... ... @@ -149,7 +149,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
    149 149 
             -- and BUILD is the same as our HOST.
    150 150
    151 151 
         let io_manager_defs =
    152 
    -          [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] ++
    152 
    +          [ "-D__IO_MANAGER_WINIO__=2" | isWindows ] ++
    153 153 
               [ "-D__IO_MANAGER_MIO__=1"               ]
    154 154
    155 155 
         let sse_defs =

  • libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
    ... ... @@ -687,7 +687,11 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
    687 687 
                                  -- can go into an unbounded alertable wait.
    688 688 
                                  delay <- runExpiredTimeouts mgr
    689 689 
                                  registerAlertableWait delay
    690 
    -                        return $ IOFailed Nothing
    690 
    +                        -- Re-throw the original exception rather than
    691 
    +                        -- returning IOFailed. This ensures that async
    692 
    +                        -- exceptions (e.g. Timeout from System.Timeout)
    693 
    +                        -- propagate correctly to their handlers.
    694 
    +                        E.throw e
    691 695 
             let runner = do debugIO $ (dbgMsg ":: waiting ") ++ " | "  ++ show lpol
    692 696 
                             res <- readIOPort signal `catch` cancel
    693 697 
                             debugIO $ dbgMsg ":: signaled "

  • rts/Messages.c
    ... ... @@ -176,10 +176,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
    176 176 
         // BLACKHOLE has already been updated, and GC has shorted out the
    177 177 
         // indirection, so the pointer no longer points to a BLACKHOLE at
    178 178 
         // all.
    179 
    -    if (bh_info != &stg_BLACKHOLE_info &&
    180 
    -        bh_info != &stg_CAF_BLACKHOLE_info &&
    181 
    -        bh_info != &__stg_EAGER_BLACKHOLE_info &&
    182 
    -        bh_info != &stg_WHITEHOLE_info) {
    179 
    +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(bh_info)) {
    183 180 
             return 0;
    184 181 
         }
    185 182
    ... ... @@ -338,10 +335,7 @@ StgTSO * blackHoleOwner (StgClosure *bh)
    338 335
    339 336 
         info = RELAXED_LOAD(&bh->header.info);
    340 337
    341 
    -    if (info != &stg_BLACKHOLE_info &&
    342 
    -        info != &stg_CAF_BLACKHOLE_info &&
    343 
    -        info != &__stg_EAGER_BLACKHOLE_info &&
    344 
    -        info != &stg_WHITEHOLE_info) {
    338 
    +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(info)) {
    345 339 
             return NULL;
    346 340 
         }
    347 341

  • rts/ThreadPaused.c
    ... ... @@ -183,6 +183,30 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
    183 183 
         }
    184 184 
     }
    185 185
    186 
    +/*
    187 
    + * Check whether tso is the owner of the black hole bh.
    188 
    + *
    189 
    + * We must call this from the capability that runs tso,
    190 
    + * since that guarantees that the writes to bh->indirectee
    191 
    + * by tso claiming ownership have been visible. If another
    192 
    + * tso has claimed it again afterwards we can safely suspend
    193 
    + * our work.
    194 
    + */
    195 
    +static bool
    196 
    +threadPausedBlackHoleOwner(StgTSO *tso, StgClosure *bh)
    197 
    +{
    198 
    +    StgClosure *ind = RELAXED_LOAD(&((StgInd*)bh)->indirectee);
    199 
    +    if (ind == (StgClosure*)tso) {
    200 
    +        return true;
    201 
    +    }
    202 
    +    const StgInfoTable *ind_info = GET_INFO(UNTAG_CLOSURE(ind));
    203 
    +    if (ind_info == &stg_BLOCKING_QUEUE_CLEAN_info
    204 
    +        || ind_info == &stg_BLOCKING_QUEUE_DIRTY_info) {
    205 
    +        return ((StgBlockingQueue*)UNTAG_CLOSURE(ind))->owner == tso;
    206 
    +    }
    207 
    +    return false;
    208 
    +}
    209 
    +
    186 210 
     /* -----------------------------------------------------------------------------
    187 211 
      * Pausing a thread
    188 212 
      *
    ... ... @@ -255,11 +279,10 @@ threadPaused(Capability *cap, StgTSO *tso)
    255 279 
                 // Note [suspend duplicate work]
    256 280 
                 // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    257 281 
                 // If the info table is a WHITEHOLE or a BLACKHOLE, then
    258 
    -            // another thread has claimed it (via the SET_INFO()
    259 
    -            // below), or is in the process of doing so.  In that case
    260 
    -            // we want to suspend the work that the current thread has
    261 
    -            // done on this thunk and wait until the other thread has
    262 
    -            // finished.
    282 
    +            // some thread has claimed it, or is in the process of doing
    283 
    +            // so. In that case we want to suspend the work that the
    284 
    +            // current thread has done on this thunk and wait until the
    285 
    +            // other thread has finished.
    263 286 
                 //
    264 287 
                 // If eager blackholing is taking place, it could be the
    265 288 
                 // case that the blackhole points to the current
    ... ... @@ -287,8 +310,8 @@ threadPaused(Capability *cap, StgTSO *tso)
    287 310 
                 // Note that great care is required when entering computations
    288 311 
                 // suspended by this mechanism. See Note [AP_STACKs must be eagerly
    289 312 
                 // blackholed] for details.
    290 
    -            if (((bh_info == &stg_BLACKHOLE_info)
    291 
    -                 && (RELAXED_LOAD(&((StgInd*)bh)->indirectee) != (StgClosure*)tso))
    313 
    +            if ((IS_BLACKHOLE_INFO(bh_info)
    314 
    +                && !threadPausedBlackHoleOwner(tso, bh))
    292 315 
                     || (bh_info == &stg_WHITEHOLE_info))
    293 316 
                 {
    294 317 
                     debugTrace(DEBUG_squeeze,
    ... ... @@ -318,14 +341,14 @@ threadPaused(Capability *cap, StgTSO *tso)
    318 341 
                 // If we have a frame that is already eagerly blackholed, we
    319 342 
                 // shouldn't overwrite its payload: There may already be a blocking
    320 343 
                 // queue (see #26324).
    321 
    -            if(frame_info == &stg_bh_upd_frame_info) {
    322 
    -                // eager black hole: we do nothing
    323 
    -
    324 
    -                // it should be a black hole that we own
    325 
    -                ASSERT(bh_info == &stg_BLACKHOLE_info ||
    326 
    -                       bh_info == &__stg_EAGER_BLACKHOLE_info ||
    327 
    -                       bh_info == &stg_CAF_BLACKHOLE_info);
    328 
    -                ASSERT(blackHoleOwner(bh) == tso || blackHoleOwner(bh) == NULL);
    344 
    +            if(frame_info == &stg_bh_upd_frame_info
    345 
    +               || IS_BLACKHOLE_INFO(bh_info)) {
    346 
    +                // already a black hole: we do nothing
    347 
    +
    348 
    +                // it should be a black hole (but we may not own it, as another
    349 
    +                // thread could have raced us to claim it)
    350 
    +                ASSERT(IS_BLACKHOLE_INFO(bh_info));
    351 
    +
    329 352 
                 } else {
    330 353 
                     // lazy black hole
    331 354

  • rts/Threads.c
    ... ... @@ -439,7 +439,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso)
    439 439 
             // thing the result would be the same in almost all cases. See #20093.
    440 440 
             p = UNTAG_CLOSURE(bq->bh);
    441 441 
             const StgInfoTable *pinfo = ACQUIRE_LOAD(&p->header.info);
    442 
    -        if (pinfo != &stg_BLACKHOLE_info ||
    442 
    +        if (!IS_BLACKHOLE_INFO(pinfo) ||
    443 443 
                 (RELAXED_LOAD(&((StgInd *)p)->indirectee) != (StgClosure*)bq))
    444 444 
             {
    445 445 
                 wakeBlockingQueue(cap,bq);
    ... ... @@ -463,10 +463,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val)
    463 463 
         const StgInfoTable *i;
    464 464
    465 465 
         i = ACQUIRE_LOAD(&thunk->header.info);
    466 
    -    if (i != &stg_BLACKHOLE_info &&
    467 
    -        i != &stg_CAF_BLACKHOLE_info &&
    468 
    -        i != &__stg_EAGER_BLACKHOLE_info &&
    469 
    -        i != &stg_WHITEHOLE_info) {
    466 
    +    if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(i)) {
    470 467 
             updateWithIndirection(cap, thunk, val);
    471 468 
             return;
    472 469 
         }

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

  • rts/include/rts/storage/ClosureMacros.h
    ... ... @@ -374,6 +374,18 @@ EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
    374 374 
     EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
    375 375 
     { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
    376 376
    377 
    +/* -----------------------------------------------------------------------------
    378 
    +   Blackhole predicates
    379 
    +   -------------------------------------------------------------------------- */
    380 
    +
    381 
    +#define IS_BLACKHOLE_INFO(info) \
    382 
    +    ((info) == &stg_BLACKHOLE_info || \
    383 
    +     (info) == &__stg_EAGER_BLACKHOLE_info || \
    384 
    +     (info) == &stg_CAF_BLACKHOLE_info)
    385 
    +
    386 
    +#define IS_BLACKHOLE_OR_WHITEHOLE_INFO(info) \
    387 
    +    (IS_BLACKHOLE_INFO(info) || (info) == &stg_WHITEHOLE_info)
    388 
    +
    377 389 
     /* --------------------------------------------------------------------------
    378 390 
        Sizes of closures
    379 391 
        ------------------------------------------------------------------------*/

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help