[Git][ghc/ghc][master] rts: fix ctoi_tuple_spill_words getting out of sync

8 Sep 2026


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


Commits:
192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00
rts: fix ctoi_tuple_spill_words getting out of sync

Fix a few places that were not updating ctoi_tuple_spill_words
correctly, leading to corruption/crashes when dealing with large
unboxed tuples in bytecode:

 - captureContinuationAndAbort
 - findRetryFrameHelper/findAtomicallyFrameHelper
 - interpretBCO bci_BRK_FUN

fixes #27633

- - - - -


14 changed files:

- rts/Continuation.c
- rts/Interpreter.c
- rts/Schedule.c
- + testsuite/tests/bytecode/T27633/Obj.hs
- + testsuite/tests/bytecode/T27633/T27633a.hs
- + testsuite/tests/bytecode/T27633/T27633a.stdout
- + testsuite/tests/bytecode/T27633/T27633b.hs
- + testsuite/tests/bytecode/T27633/T27633b.stdout
- + testsuite/tests/bytecode/T27633/all.T
- + testsuite/tests/ghci.debugger/scripts/T27633c.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.script
- + testsuite/tests/ghci.debugger/scripts/T27633c.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
- testsuite/tests/ghci.debugger/scripts/all.T


Changes:

=====================================
rts/Continuation.c
=====================================
@@ -392,6 +392,10 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
   const StgInfoTable *apply_mask_frame = NULL;
   StgWord mask_frame_offset = 0;
 
+  // see Note [GHCi unboxed tuples stack spills]
+  bool seen_ctoi_tuple_frame = false;
+  StgWord ctoi_tuple_spill_words = 0;
+
   /* --- Phase 1: Find the matching prompt frame ---------------------------- */
 
   IF_DEBUG(continuation,
@@ -459,7 +463,8 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
 
     // see Note [GHCi unboxed tuples stack spills]
     if (info_ptr == &stg_ctoi_t_info) {
-      tso->ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
+      seen_ctoi_tuple_frame = true;
+      ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
     }
 
     // Advance to the next frame.
@@ -475,6 +480,11 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
   dirty_TSO(cap, tso);
   dirty_STACK(cap, stack);
 
+  // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+  if (seen_ctoi_tuple_frame) {
+    tso->ctoi_tuple_spill_words = ctoi_tuple_spill_words;
+  }
+
   StgContinuation *cont = (StgContinuation *)allocate(cap, CONTINUATION_sizeW(total_words));
   SET_HDR(cont, &stg_CONTINUATION_info, stack->header.prof.ccs);
   cont->apply_mask_frame = apply_mask_frame;


=====================================
rts/Interpreter.c
=====================================
@@ -1982,6 +1982,20 @@ run_BCO:
                     for (i = 0; i < size_words; i++) {
                        new_aps->payload[i] = (StgClosure *)ReadSpW(i);
                     }
+
+                    /* The stg_ctoi_t frame we copied is entered again when
+                       execution resumes, but tso->ctoi_tuple_spill_words
+                       holds the enclosing frame's count: it was restored
+                       from old_spill when this case continuation was entered
+                       (bci_RETURN_T). Put back the count belonging to this
+                       frame, so the invariant holds while the thread sits at
+                       the breakpoint.
+
+                       See Note [GHCi unboxed tuples stack spills] */
+                    if (ReadSpW(size_returned_frame) == (W_)&stg_ctoi_t_info) {
+                        cap->r.rCurrentTSO->ctoi_tuple_spill_words =
+                            ReadSpW(size_returned_frame + CTOI_TUPLE_INFO_OFFSET) >> 24;
+                    }
                   }
                   else {
 


=====================================
rts/Schedule.c
=====================================
@@ -3271,6 +3271,10 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso)
     default:
       ASSERT(info->i.type != CATCH_FRAME);
       ASSERT(info->i.type != STOP_FRAME);
+      // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+      if (*p == (StgWord)&stg_ctoi_t_info) {
+          tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
+      }
       p = next;
       continue;
     }
@@ -3332,6 +3336,10 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso)
     default:
       ASSERT(info->i.type != CATCH_FRAME);
       ASSERT(info->i.type != STOP_FRAME);
+      // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
+      if (*p == (StgWord)&stg_ctoi_t_info) {
+          tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
+      }
       p = next;
       continue;
     }


=====================================
testsuite/tests/bytecode/T27633/Obj.hs
=====================================
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -fobject-code #-}
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module Obj where
+
+import GHC.Exts
+
+-- Compiled to object code; returns a large unboxed tuple, so the return
+-- into an interpreted caller goes through the native stg_ctoi_t entry code,
+-- which reads tso->ctoi_tuple_spill_words.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+mkT :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+mkT s = (# s, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16#, 17#, 18#, 19#, 20#, 21#, 22#, 23#, 24# #)
+{-# NOINLINE mkT #-}


=====================================
testsuite/tests/bytecode/T27633/T27633a.hs
=====================================
@@ -0,0 +1,34 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+{-# OPTIONS_GHC -fbyte-code #-}
+
+-- Regression test for #27633 (bug 1): a failed control0# capture must not
+-- clobber tso->ctoi_tuple_spill_words while a generic stg_ctoi_t frame is
+-- still live on the stack.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import Control.Exception
+import GHC.Exts
+import GHC.IO (IO(..))
+import Obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+-- control0# with a tag that has no matching prompt anywhere on the stack;
+-- the resulting exception is caught right here, above the stg_ctoi_t frame,
+-- so the unwind stops before reaching the frame.
+failing :: IO ()
+failing = IO (\s0 -> case newPromptTag# s0 of
+                (# s1, tag #) -> control0# tag (\_ s -> (# s, () #)) s1)
+          `catch` \(SomeException _) -> return ()
+
+scrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+scrut s0 = case unIO failing s0 of (# s1, _ #) -> mkT s1
+{-# NOINLINE scrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case scrut s0 of
+             (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+               unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)


=====================================
testsuite/tests/bytecode/T27633/T27633a.stdout
=====================================
@@ -0,0 +1 @@
+300


=====================================
testsuite/tests/bytecode/T27633/T27633b.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+{-# OPTIONS_GHC -fbyte-code #-}
+
+-- Regression test for #27633 (bug 2): STM retry unwinding
+-- (findRetryFrameHelper/findAtomicallyFrameHelper) must restore
+-- tso->ctoi_tuple_spill_words when it discards a generic stg_ctoi_t frame.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import GHC.Conc (STM(..), atomically, orElse)
+import GHC.Exts
+import GHC.IO (IO(..))
+import Obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+-- Inside the transaction: case on a 16-field tuple (different spill count
+-- than the outer 24-field one), then retry. The generic stg_ctoi_t frame
+-- pushed for this case is discarded by findRetryFrameHelper.
+innerScrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+innerScrut s0 = case retry# s0 of (# s1, () #) -> (# s1, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16# #)
+{-# NOINLINE innerScrut #-}
+
+stmBody :: STM ()
+stmBody = STM (\s0 -> case innerScrut s0 of
+                (# s1, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16 #) -> (# s1, () #))
+
+outerScrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+outerScrut s0 =
+  case unIO (atomically (stmBody `orElse` return ())) s0 of
+    (# s1, _ #) -> mkT s1
+{-# NOINLINE outerScrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case outerScrut s0 of
+             (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+               unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)


=====================================
testsuite/tests/bytecode/T27633/T27633b.stdout
=====================================
@@ -0,0 +1 @@
+300


=====================================
testsuite/tests/bytecode/T27633/all.T
=====================================
@@ -0,0 +1,21 @@
+test('T27633a',
+     [ extra_files(['Obj.hs']),
+       req_interp,
+       req_bco,
+       only_ways(ghci_ways),
+       extra_ways(ghci_ways),
+     ],
+     compile_and_run,
+     ['']
+    )
+
+test('T27633b',
+     [ extra_files(['Obj.hs']),
+       req_interp,
+       req_bco,
+       only_ways(ghci_ways),
+       extra_ways(ghci_ways),
+     ],
+     compile_and_run,
+     ['']
+    )


=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.hs
=====================================
@@ -0,0 +1,29 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+
+-- Stopping at a breakpoint in the case continuation of a large unboxed
+-- tuple return (generic stg_ctoi_t frame) and resuming must re-enter the
+-- frame with the correct tso->ctoi_tuple_spill_words. The continuation
+-- breakpoint is activated via :stepout.
+-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
+
+module Main where
+
+import GHC.Exts
+import GHC.IO (IO(..))
+import T27633c_obj
+
+unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
+unIO (IO f) = f
+
+poke :: Int -> IO Int
+poke x =
+  return (x + 1)          -- line 20: initial breakpoint
+
+scrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+scrut s0 = case unIO (poke 41) s0 of (# s1, _ #) -> mkT s1
+{-# NOINLINE scrut #-}
+
+main :: IO ()
+main = IO (\s0 -> case scrut s0 of
+             (# s1, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24 #) ->
+               unIO (print (I# (x1 +# x2 +# x3 +# x4 +# x5 +# x6 +# x7 +# x8 +# x9 +# x10 +# x11 +# x12 +# x13 +# x14 +# x15 +# x16 +# x17 +# x18 +# x19 +# x20 +# x21 +# x22 +# x23 +# x24))) s1)


=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.script
=====================================
@@ -0,0 +1,13 @@
+:load T27633c.hs
+-- break inside poke, while the generic stg_ctoi_t frame from main's
+-- 24-field tuple case is live on the stack
+:break 20
+main
+-- step out to the small case continuation in scrut
+:stepout
+-- step out again: activates the breakpoint of main's tuple case
+-- continuation BCO, entered through the generic stg_ctoi_t frame
+:stepout
+-- resuming re-enters the stg_ctoi_t frame; with a stale
+-- tso->ctoi_tuple_spill_words this segfaulted
+:continue


=====================================
testsuite/tests/ghci.debugger/scripts/T27633c.stdout
=====================================
@@ -0,0 +1,9 @@
+Breakpoint 0 activated at T27633c.hs:20:3-16
+Stopped in Main.poke, T27633c.hs:20:3-16
+_result :: IO Int = _
+x :: Int = 41
+Stopped in Main.scrut, T27633c.hs:23:17-33
+_result :: (# State# RealWorld, Int #) = _
+Stopped in Main.main, T27633c.hs:(27,19)-(29,193)
+_result :: (# State# RealWorld, () #) = _
+300


=====================================
testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -fobject-code #-}
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module T27633c_obj where
+
+import GHC.Exts
+
+-- Compiled to object code; returns a large unboxed tuple, so the return
+-- into an interpreted caller goes through the native stg_ctoi_t entry code,
+-- which reads tso->ctoi_tuple_spill_words.
+mkT :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
+mkT s = (# s, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16#, 17#, 18#, 19#, 20#, 21#, 22#, 23#, 24# #)
+{-# NOINLINE mkT #-}


=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -153,3 +153,5 @@ test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
 test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
 test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
 test('T26042g', extra_files(['T26042g.hs']), ghci_script, ['T26042g.script'])
+
+test('T27633c', extra_files(['T27633c_obj.hs']), ghci_script, ['T27633c.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/192be0b6b861725613a9be5cb1587fb8...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/192be0b6b861725613a9be5cb1587fb8...
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

    

Marge Bot (＠marge-bot)

tags

participants (1)