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

Commits:

5 changed files:

Changes:

  • changelog.d/fix-control0-mask-trampoline
    1 
    +section: rts
    2 
    +synopsis: Fix a crash when capturing or resuming a delimited continuation that adjusts the async exception masking state
    3 
    +issues: #27651
    4 
    +mrs: !16484
    5 
    +
    6 
    +description: {
    7 
    +Capturing a continuation with ``control0#`` from inside ``mask`` or
    8 
    +``uninterruptibleMask`` left an uninitialised word on the stack while
    9 
    +restoring the masking state. When the thread had a pending asynchronous
    10 
    +exception (e.g. from ``throwTo``), raising it walked over that word and
    11 
    +crashed with a segmentation fault. Resuming such a continuation had the
    12 
    +same defect.
    13 
    +}

  • rts/ContinuationOps.cmm
    ... ... @@ -148,6 +148,7 @@ stg_control0zh_ll // explicit stack
    148 148 
       // and jump to the frame’s entry code.
    149 149 
       Sp_adj(-3); // Note -3, not -2, because `mask_frame` will
    150 150 
                   // try to pop itself off the stack when it returns!
    151 
    +  Sp(0) = mask_frame; // Can't be omitted, see #27651
    151 152 
       Sp(1) = stg_ap_pv_info;
    152 153 
       Sp(2) = cont;
    153 154 
       R1 = f;
    ... ... @@ -230,6 +231,7 @@ stg_CONTINUATION_apply // explicit stack
    230 231 
       // Now we just set up the stack so that `apply_mask_frame` will apply `io`
    231 232 
       // when it returns and jump to it.
    232 233 
       Sp_adj(-2);
    234 
    +  Sp(0) = apply_mask_frame; // Can't be omitted, see #27651
    233 235 
       Sp(1) = stg_ap_v_info;
    234 236 
       R1 = io;
    235 237 
       jump %ENTRY_CODE(apply_mask_frame) [R1];

  • testsuite/tests/rts/continuations/T27651.hs
    1 
    +-- When capturing or resuming a continuation adjusts the async exception
    2 
    +-- masking state, the RTS trampolines through a mask/unmask frame, and the
    3 
    +-- stack must be well-formed at that point: with a blocked exception
    4 
    +-- pending, the eager raise in stg_unmaskAsyncExceptionszh_ret walks the
    5 
    +-- whole stack.
    6 
    +--
    7 
    +-- Phase 1 exercises the capture side (stg_control0zh_ll): control0# runs
    8 
    +-- inside uninterruptibleMask_ while another thread has queued an
    9 
    +-- exception via throwTo, so the capture unmasks with the exception
    10 
    +-- pending. The frame evaluated between the unmask frame and the prompt
    11 
    +-- keeps raw Int# payload live so that a stale word on the stack cannot
    12 
    +-- masquerade as a valid frame by accident.
    13 
    +--
    14 
    +-- Phase 2 exercises the resume side (stg_CONTINUATION_apply): the
    15 
    +-- continuation is captured while unmasked (inside mask/restore), so
    16 
    +-- resuming it unmasks, and it is applied from a thread that is masked
    17 
    +-- with an exception pending.
    18 
    +import Control.Concurrent
    19 
    +import Control.Exception
    20 
    +import Control.Monad
    21 
    +
    22 
    +import ContIO
    23 
    +
    24 
    +data Boom = Boom deriving Show
    25 
    +instance Exception Boom
    26 
    +
    27 
    +{-# NOINLINE useInts #-}
    28 
    +useInts :: Int -> Int -> Int -> Int -> Int -> Int
    29 
    +useInts a b c d e = a + b * c + d * e
    30 
    +
    31 
    +rounds :: Int
    32 
    +rounds = 150
    33 
    +
    34 
    +phase1 :: Int -> IO ()
    35 
    +phase1 i = do
    36 
    +  mv   <- newEmptyMVar
    37 
    +  done <- newEmptyMVar
    38 
    +  let !p = i * 7919 + 3    -- raw ints to live in the continuation frame
    39 
    +      !q = i * 104729 + 7
    40 
    +      !u = i * 1299709 + 11
    41 
    +      !v = i * 15485863 + 13
    42 
    +  a <- forkIO $
    43 
    +    handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do
    44 
    +      tag <- newPromptTag
    45 
    +      r <- prompt tag $ do
    46 
    +             x <- uninterruptibleMask_ $ do
    47 
    +                    putMVar mv ()
    48 
    +                    threadDelay 2000  -- let the thrower queue its exception
    49 
    +                    control0 tag (\_k -> pure (42 :: Int))
    50 
    +             -- continuation frame between the unmask frame and the
    51 
    +             -- prompt frame, carrying raw Int# payload:
    52 
    +             pure (useInts x p q u v)
    53 
    +      void (tryPutMVar done (Right r))
    54 
    +  takeMVar mv
    55 
    +  _ <- forkIO $ throwTo a Boom
    56 
    +  void (takeMVar done)
    57 
    +
    58 
    +phase2 :: Int -> IO ()
    59 
    +phase2 i = do
    60 
    +  mv   <- newEmptyMVar
    61 
    +  done <- newEmptyMVar
    62 
    +  kvar <- newEmptyMVar
    63 
    +  let !p = i * 7919 + 3
    64 
    +      !q = i * 104729 + 7
    65 
    +      !u = i * 1299709 + 11
    66 
    +      !v = i * 15485863 + 13
    67 
    +  -- Capture a continuation whose resumption unmasks: the capture happens
    68 
    +  -- inside restore, so its apply_mask_frame is the unmask frame.
    69 
    +  _ <- forkIO $ do
    70 
    +    tag <- newPromptTag
    71 
    +    _ <- prompt tag $ mask $ \restore -> do
    72 
    +           x <- restore (control0 tag (\k -> putMVar kvar k >> pure 0))
    73 
    +           pure (useInts x p q u v)
    74 
    +    pure ()
    75 
    +  k <- takeMVar kvar
    76 
    +  a <- forkIO $
    77 
    +    handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do
    78 
    +      r <- uninterruptibleMask_ $ do
    79 
    +             putMVar mv ()
    80 
    +             threadDelay 2000  -- let the thrower queue its exception
    81 
    +             k (pure 42)  -- resuming unmasks with the exception pending
    82 
    +      void (tryPutMVar done (Right r))
    83 
    +  takeMVar mv
    84 
    +  _ <- forkIO $ throwTo a Boom
    85 
    +  void (takeMVar done)
    86 
    +
    87 
    +main :: IO ()
    88 
    +main = do
    89 
    +  forM_ [1 .. rounds] phase1
    90 
    +  forM_ [1 .. rounds] phase2
    91 
    +  putStrLn "ok"

  • testsuite/tests/rts/continuations/T27651.stdout
    1 
    +ok

  • testsuite/tests/rts/continuations/all.T
    ... ... @@ -9,3 +9,4 @@ test('cont_nondet_handler', [extra_files(['ContIO.hs'])], multimod_compile_and_r
    9 9 
     test('cont_stack_overflow', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['cont_stack_overflow', '-with-rtsopts "-ki1k -kc2k -kb256"'])
    10 10
    11 11 
     test('T23513', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T23513', ''])
    12 
    +test('T27651', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T27651', ''])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/5796aa637cca079854fc7e84e7e0fa497aacab3c at 1789495678