Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5796aa63 by Luite Stegeman at 2026-09-15T14:07:49-04:00 rts: initialise the stack frame header for mask_frame and apply_mask_frame We must leave the stack in consistent state before jumping to mask_frame or apply_mask_frame because they may result. Failing to do so could lead to a crash if there were waiting exceptions. Fixes #27651 - - - - - 5 changed files: - + changelog.d/fix-control0-mask-trampoline - rts/ContinuationOps.cmm - + testsuite/tests/rts/continuations/T27651.hs - + testsuite/tests/rts/continuations/T27651.stdout - testsuite/tests/rts/continuations/all.T Changes: ===================================== changelog.d/fix-control0-mask-trampoline ===================================== @@ -0,0 +1,13 @@ +section: rts +synopsis: Fix a crash when capturing or resuming a delimited continuation that adjusts the async exception masking state +issues: #27651 +mrs: !16484 + +description: { +Capturing a continuation with ``control0#`` from inside ``mask`` or +``uninterruptibleMask`` left an uninitialised word on the stack while +restoring the masking state. When the thread had a pending asynchronous +exception (e.g. from ``throwTo``), raising it walked over that word and +crashed with a segmentation fault. Resuming such a continuation had the +same defect. +} ===================================== rts/ContinuationOps.cmm ===================================== @@ -148,6 +148,7 @@ stg_control0zh_ll // explicit stack // and jump to the frame’s entry code. Sp_adj(-3); // Note -3, not -2, because `mask_frame` will // try to pop itself off the stack when it returns! + Sp(0) = mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_pv_info; Sp(2) = cont; R1 = f; @@ -230,6 +231,7 @@ stg_CONTINUATION_apply // explicit stack // Now we just set up the stack so that `apply_mask_frame` will apply `io` // when it returns and jump to it. Sp_adj(-2); + Sp(0) = apply_mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_v_info; R1 = io; jump %ENTRY_CODE(apply_mask_frame) [R1]; ===================================== testsuite/tests/rts/continuations/T27651.hs ===================================== @@ -0,0 +1,91 @@ +-- When capturing or resuming a continuation adjusts the async exception +-- masking state, the RTS trampolines through a mask/unmask frame, and the +-- stack must be well-formed at that point: with a blocked exception +-- pending, the eager raise in stg_unmaskAsyncExceptionszh_ret walks the +-- whole stack. +-- +-- Phase 1 exercises the capture side (stg_control0zh_ll): control0# runs +-- inside uninterruptibleMask_ while another thread has queued an +-- exception via throwTo, so the capture unmasks with the exception +-- pending. The frame evaluated between the unmask frame and the prompt +-- keeps raw Int# payload live so that a stale word on the stack cannot +-- masquerade as a valid frame by accident. +-- +-- Phase 2 exercises the resume side (stg_CONTINUATION_apply): the +-- continuation is captured while unmasked (inside mask/restore), so +-- resuming it unmasks, and it is applied from a thread that is masked +-- with an exception pending. +import Control.Concurrent +import Control.Exception +import Control.Monad + +import ContIO + +data Boom = Boom deriving Show +instance Exception Boom + +{-# NOINLINE useInts #-} +useInts :: Int -> Int -> Int -> Int -> Int -> Int +useInts a b c d e = a + b * c + d * e + +rounds :: Int +rounds = 150 + +phase1 :: Int -> IO () +phase1 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + let !p = i * 7919 + 3 -- raw ints to live in the continuation frame + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + tag <- newPromptTag + r <- prompt tag $ do + x <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + control0 tag (\_k -> pure (42 :: Int)) + -- continuation frame between the unmask frame and the + -- prompt frame, carrying raw Int# payload: + pure (useInts x p q u v) + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +phase2 :: Int -> IO () +phase2 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + kvar <- newEmptyMVar + let !p = i * 7919 + 3 + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + -- Capture a continuation whose resumption unmasks: the capture happens + -- inside restore, so its apply_mask_frame is the unmask frame. + _ <- forkIO $ do + tag <- newPromptTag + _ <- prompt tag $ mask $ \restore -> do + x <- restore (control0 tag (\k -> putMVar kvar k >> pure 0)) + pure (useInts x p q u v) + pure () + k <- takeMVar kvar + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + r <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + k (pure 42) -- resuming unmasks with the exception pending + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +main :: IO () +main = do + forM_ [1 .. rounds] phase1 + forM_ [1 .. rounds] phase2 + putStrLn "ok" ===================================== testsuite/tests/rts/continuations/T27651.stdout ===================================== @@ -0,0 +1 @@ +ok ===================================== testsuite/tests/rts/continuations/all.T ===================================== @@ -9,3 +9,4 @@ test('cont_nondet_handler', [extra_files(['ContIO.hs'])], multimod_compile_and_r test('cont_stack_overflow', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['cont_stack_overflow', '-with-rtsopts "-ki1k -kc2k -kb256"']) test('T23513', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T23513', '']) +test('T27651', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T27651', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5796aa637cca079854fc7e84e7e0fa49... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5796aa637cca079854fc7e84e7e0fa49... 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