+    if (running_alt_code != 1) {

+      // When exiting the lhs code of catchRetry# lhs rhs, we need to cleanup

+      // the nested transaction.

+      // See Note [catchRetry# implementation]

+      outer  = StgTRecHeader_enclosing_trec(trec);

+      (r) = ccall stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr");

+      if (r != 0) {

+          // Succeeded in first branch

+          StgTSO_trec(CurrentTSO) = outer;

+          return (ret);

+      } else {

+          // Did not commit: abort and restart.

+          StgTSO_trec(CurrentTSO) = outer;

+          jump stg_abort();

+      }

+    }

+    else {

+      // nothing to do in the rhs code of catchRetry# lhs rhs, it's already

+      // using the parent transaction (not a nested one).

+      // See Note [catchRetry# implementation]

+      return (ret);

+        // The retry reaches a CATCH_RETRY_FRAME before the ATOMICALLY_FRAME

+

+            // Retrying in the lhs of catchRetry# lhs rhs, i.e. in a nested

+            // transaction. See Note [catchRetry# implementation]

+

+            // check that we have a parent transaction

+            ASSERT(outer != NO_TREC);

+

+            // Abort the nested transaction

+            ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");

+            ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");

+

+            // As we are retrying in the lhs code, we must now try the rhs code

+            StgTSO_trec(CurrentTSO) = outer;

+            // Retry in the rhs code: propagate the retry

+            // CATCH_STM frame within an atomically block: abort the

+            debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_STM frame");

+        case CATCH_RETRY_FRAME:

+            // CATCH_RETRY frame within an atomically block: if we're executing

+            // the lhs code, abort the inner transaction and continue; if we're

+            // executing the rhs, continue (no nested transaction to abort. See

+            // Note [catchRetry# implementation]). Eventually we will hit the

+            // outer transaction that will get frozen (see above).

+            //

+            // As for the CATCH_STM_FRAME case above, we do not care

+            // whether the transaction is valid or not because its

+            // possible validity cannot have caused the exception

+            // and will not be visible after the abort.

+        {

+            debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_RETRY frame");

+            stmAbortNestedCatchRetryTransaction(cap, tso, (StgCatchRetryFrame *)frame);

+            break;

+        };

+

+/*

+Note [catchRetry# implementation]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+catchRetry# creates a nested transaction for its lhs:

+- if the lhs transaction succeeds:

+    - the lhs transaction is committed

+    - its read-variables are merged with those of the parent transaction

+    - the rhs code is ignored

+- if the lhs transaction retries:

+    - the lhs transaction is aborted

+    - its read-variables are merged with those of the parent transaction

+    - the rhs code is executed directly in the parent transaction (see #26028).

+

+So note that:

+- lhs code uses a nested transaction

+- rhs code doesn't use a nested transaction

+

+We have to take which case we're in into account (using the running_alt_code

+field of the catchRetry frame) in catchRetry's entry code, in retry#

+implementation, and also when an async exception is received (to cleanup the

+right number of transactions).

+*/

+

+/* Called when unwinding past a CATCH_RETRY_FRAME.

+ * Only aborts the transaction if we're executing the lhs (running_alt_code=0),

+ * because rhs code uses the parent transaction directly with no nested trec.

+ * See Note [catchRetry# implementation].

+ */

+void stmAbortNestedCatchRetryTransaction(Capability *cap,

+                                         StgTSO *tso,

+                                         StgCatchRetryFrame *frame) {

+  if (!frame->running_alt_code) {

+    StgTRecHeader *trec = tso->trec;

+    StgTRecHeader *outer = trec->enclosing_trec;

+    stmAbortTransaction(cap, trec);

+    stmFreeAbortedTRec(cap, trec);

+    tso->trec = outer;

+  }

+}

+

+void stmAbortNestedCatchRetryTransaction(Capability *cap,

+                                         StgTSO *tso,

+                                         StgCatchRetryFrame *frame);

+            stmAbortNestedCatchRetryTransaction(cap, tso, (StgCatchRetryFrame *)p);

+        stmAbortNestedCatchRetryTransaction(cap, tso, (StgCatchRetryFrame *)p);

+module Main where

+

+import GHC.Conc

+

+forever :: IO String

+forever = delay 10 >> forever

+

+terminates :: IO String

+terminates = delay 1 >> pure "terminates"

+

+delay s = threadDelay (1000000 * s)

+

+async :: IO a -> IO (STM a)

+async a = do

+  var <- atomically (newTVar Nothing)

+  forkIO (a >>= atomically . writeTVar var . Just)

+  pure (readTVar var >>= maybe retry pure)

+

+main :: IO ()

+main = do

+  x <- mapM async $ terminates : replicate 50000 forever

+  r <- atomically (foldr1 orElse x)

+  print r

+"terminates"

+module Main where

+

+import Control.Concurrent.STM

+import Control.Exception

+

+main :: IO ()

+main = do

+  result <- try @SomeException $ atomically $

+    -- LHS retries → CATCH_RETRY_FRAME gets running_alt_code=1, RHS executes.

+    -- RHS throws → raiseExceptionHelper walks the stack, finds the

+    -- CATCH_RETRY_FRAME (running_alt_code=1), and must NOT abort tso->trec.

+    orElse retry (throwSTM (ErrorCall "test"))

+  case result of

+    Left _  -> putStrLn "OK"

+    Right _ -> putStrLn "impossible"

+OK

+-- Test for the findAtomicallyFrameHelper crash when running_alt_code=1.

+--

+-- findAtomicallyFrameHelper is called by stg_abort, which fires when a nested

+-- transaction's stmCommitNestedTransaction fails (due to a concurrent TVar

+-- write conflicting with the nested trec's read set).  If the walk encounters

+-- a CATCH_RETRY_FRAME with running_alt_code=1, the old code unconditionally

+-- called stmAbortTransaction on tso->trec, which is the *parent* transaction

+-- (no nested trec exists for the RHS).  That freed the parent trec, leaving

+-- tso->trec as garbage; stg_abort then dereferenced it and crashed.

+--

+-- The structure that exercises this:

+--   outer orElse: LHS retries → RHS runs (outer CATCH_RETRY_FRAME has running_alt_code=1)

+--   inner orElse: LHS reads a TVar in a nested trec and tries to commit

+--     → if a concurrent writer invalidates the read, stmCommitNestedTransaction fails

+--     → stg_abort → findAtomicallyFrameHelper encounters the outer CATCH_RETRY_FRAME

+--       (running_alt_code=1) → crash without the fix.

+module Main where

+

+import Control.Concurrent

+import Control.Concurrent.STM

+

+main :: IO ()

+main = do

+  tv <- newTVarIO (0 :: Int)

+

+  -- Continuously modify tv to provoke nested-commit failures.

+  _ <- forkIO $ let loop = atomically (modifyTVar' tv (+1)) >> loop in loop

+

+  -- Run the critical orElse pattern many times.  Each iteration the inner LHS

+  -- reads tv (nested trec) and tries to commit; concurrent writes will

+  -- occasionally cause the commit to fail and trigger stg_abort.

+  let loop 0 = return ()

+      loop n = do

+        _ <- atomically $

+          orElse

+            retry                             -- outer LHS: always retries

+            (orElse (readTVar tv) (return 0)) -- outer RHS (running_alt_code=1):

+                                              --   inner LHS reads tv (nested trec)

+        loop (n - 1)

+  loop (100000 :: Int)

+

+  putStrLn "OK"

+OK

+test('T26028', only_ways(['threaded1']), compile_and_run, ['-O2'])

+test('T26291a', normal, compile_and_run, ['-O2'])

+test('T26291b', only_ways(['threaded1']), compile_and_run, ['-O2'])