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

Commits:

14 changed files:

Changes:

  • rts/Continuation.c
    ... ... @@ -392,6 +392,10 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
    392 392 
       const StgInfoTable *apply_mask_frame = NULL;
    393 393 
       StgWord mask_frame_offset = 0;
    394 394
    395 
    +  // see Note [GHCi unboxed tuples stack spills]
    396 
    +  bool seen_ctoi_tuple_frame = false;
    397 
    +  StgWord ctoi_tuple_spill_words = 0;
    398 
    +
    395 399 
       /* --- Phase 1: Find the matching prompt frame ---------------------------- */
    396 400
    397 401 
       IF_DEBUG(continuation,
    ... ... @@ -459,7 +463,8 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
    459 463
    460 464 
         // see Note [GHCi unboxed tuples stack spills]
    461 465 
         if (info_ptr == &stg_ctoi_t_info) {
    462 
    -      tso->ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
    466 
    +      seen_ctoi_tuple_frame = true;
    467 
    +      ctoi_tuple_spill_words = frame[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET];
    463 468 
         }
    464 469
    465 470 
         // Advance to the next frame.
    ... ... @@ -475,6 +480,11 @@ StgClosure *captureContinuationAndAbort(Capability *cap, StgTSO *tso, StgPromptT
    475 480 
       dirty_TSO(cap, tso);
    476 481 
       dirty_STACK(cap, stack);
    477 482
    483 
    +  // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
    484 
    +  if (seen_ctoi_tuple_frame) {
    485 
    +    tso->ctoi_tuple_spill_words = ctoi_tuple_spill_words;
    486 
    +  }
    487 
    +
    478 488 
       StgContinuation *cont = (StgContinuation *)allocate(cap, CONTINUATION_sizeW(total_words));
    479 489 
       SET_HDR(cont, &stg_CONTINUATION_info, stack->header.prof.ccs);
    480 490 
       cont->apply_mask_frame = apply_mask_frame;

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

  • rts/Schedule.c
    ... ... @@ -3271,6 +3271,10 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso)
    3271 3271 
         default:
    3272 3272 
           ASSERT(info->i.type != CATCH_FRAME);
    3273 3273 
           ASSERT(info->i.type != STOP_FRAME);
    3274 
    +      // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
    3275 
    +      if (*p == (StgWord)&stg_ctoi_t_info) {
    3276 
    +          tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
    3277 
    +      }
    3274 3278 
           p = next;
    3275 3279 
           continue;
    3276 3280 
         }
    ... ... @@ -3332,6 +3336,10 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso)
    3332 3336 
         default:
    3333 3337 
           ASSERT(info->i.type != CATCH_FRAME);
    3334 3338 
           ASSERT(info->i.type != STOP_FRAME);
    3339 
    +      // see Note [GHCi unboxed tuples stack spills] in StgMiscClosures.cmm
    3340 
    +      if (*p == (StgWord)&stg_ctoi_t_info) {
    3341 
    +          tso->ctoi_tuple_spill_words = p[CTOI_OLD_TUPLE_SPILL_WORDS_OFFSET]; // restore old_spill
    3342 
    +      }
    3335 3343 
           p = next;
    3336 3344 
           continue;
    3337 3345 
         }

  • testsuite/tests/bytecode/T27633/Obj.hs
    1 
    +{-# OPTIONS_GHC -fobject-code #-}
    2 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    3 
    +module Obj where
    4 
    +
    5 
    +import GHC.Exts
    6 
    +
    7 
    +-- Compiled to object code; returns a large unboxed tuple, so the return
    8 
    +-- into an interpreted caller goes through the native stg_ctoi_t entry code,
    9 
    +-- which reads tso->ctoi_tuple_spill_words.
    10 
    +-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
    11 
    +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# #)
    12 
    +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# #)
    13 
    +{-# NOINLINE mkT #-}

  • testsuite/tests/bytecode/T27633/T27633a.hs
    1 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    2 
    +{-# OPTIONS_GHC -fbyte-code #-}
    3 
    +
    4 
    +-- Regression test for #27633 (bug 1): a failed control0# capture must not
    5 
    +-- clobber tso->ctoi_tuple_spill_words while a generic stg_ctoi_t frame is
    6 
    +-- still live on the stack.
    7 
    +-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
    8 
    +
    9 
    +module Main where
    10 
    +
    11 
    +import Control.Exception
    12 
    +import GHC.Exts
    13 
    +import GHC.IO (IO(..))
    14 
    +import Obj
    15 
    +
    16 
    +unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
    17 
    +unIO (IO f) = f
    18 
    +
    19 
    +-- control0# with a tag that has no matching prompt anywhere on the stack;
    20 
    +-- the resulting exception is caught right here, above the stg_ctoi_t frame,
    21 
    +-- so the unwind stops before reaching the frame.
    22 
    +failing :: IO ()
    23 
    +failing = IO (\s0 -> case newPromptTag# s0 of
    24 
    +                (# s1, tag #) -> control0# tag (\_ s -> (# s, () #)) s1)
    25 
    +          `catch` \(SomeException _) -> return ()
    26 
    +
    27 
    +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# #)
    28 
    +scrut s0 = case unIO failing s0 of (# s1, _ #) -> mkT s1
    29 
    +{-# NOINLINE scrut #-}
    30 
    +
    31 
    +main :: IO ()
    32 
    +main = IO (\s0 -> case scrut s0 of
    33 
    +             (# 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 #) ->
    34 
    +               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
    1 
    +300

  • testsuite/tests/bytecode/T27633/T27633b.hs
    1 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    2 
    +{-# OPTIONS_GHC -fbyte-code #-}
    3 
    +
    4 
    +-- Regression test for #27633 (bug 2): STM retry unwinding
    5 
    +-- (findRetryFrameHelper/findAtomicallyFrameHelper) must restore
    6 
    +-- tso->ctoi_tuple_spill_words when it discards a generic stg_ctoi_t frame.
    7 
    +-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
    8 
    +
    9 
    +module Main where
    10 
    +
    11 
    +import GHC.Conc (STM(..), atomically, orElse)
    12 
    +import GHC.Exts
    13 
    +import GHC.IO (IO(..))
    14 
    +import Obj
    15 
    +
    16 
    +unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
    17 
    +unIO (IO f) = f
    18 
    +
    19 
    +-- Inside the transaction: case on a 16-field tuple (different spill count
    20 
    +-- than the outer 24-field one), then retry. The generic stg_ctoi_t frame
    21 
    +-- pushed for this case is discarded by findRetryFrameHelper.
    22 
    +innerScrut :: State# RealWorld -> (# State# RealWorld, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int#, Int# #)
    23 
    +innerScrut s0 = case retry# s0 of (# s1, () #) -> (# s1, 1#, 2#, 3#, 4#, 5#, 6#, 7#, 8#, 9#, 10#, 11#, 12#, 13#, 14#, 15#, 16# #)
    24 
    +{-# NOINLINE innerScrut #-}
    25 
    +
    26 
    +stmBody :: STM ()
    27 
    +stmBody = STM (\s0 -> case innerScrut s0 of
    28 
    +                (# s1, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16 #) -> (# s1, () #))
    29 
    +
    30 
    +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# #)
    31 
    +outerScrut s0 =
    32 
    +  case unIO (atomically (stmBody `orElse` return ())) s0 of
    33 
    +    (# s1, _ #) -> mkT s1
    34 
    +{-# NOINLINE outerScrut #-}
    35 
    +
    36 
    +main :: IO ()
    37 
    +main = IO (\s0 -> case outerScrut s0 of
    38 
    +             (# 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 #) ->
    39 
    +               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
    1 
    +300

  • testsuite/tests/bytecode/T27633/all.T
    1 
    +test('T27633a',
    2 
    +     [ extra_files(['Obj.hs']),
    3 
    +       req_interp,
    4 
    +       req_bco,
    5 
    +       only_ways(ghci_ways),
    6 
    +       extra_ways(ghci_ways),
    7 
    +     ],
    8 
    +     compile_and_run,
    9 
    +     ['']
    10 
    +    )
    11 
    +
    12 
    +test('T27633b',
    13 
    +     [ extra_files(['Obj.hs']),
    14 
    +       req_interp,
    15 
    +       req_bco,
    16 
    +       only_ways(ghci_ways),
    17 
    +       extra_ways(ghci_ways),
    18 
    +     ],
    19 
    +     compile_and_run,
    20 
    +     ['']
    21 
    +    )

  • testsuite/tests/ghci.debugger/scripts/T27633c.hs
    1 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    2 
    +
    3 
    +-- Stopping at a breakpoint in the case continuation of a large unboxed
    4 
    +-- tuple return (generic stg_ctoi_t frame) and resuming must re-enter the
    5 
    +-- frame with the correct tso->ctoi_tuple_spill_words. The continuation
    6 
    +-- breakpoint is activated via :stepout.
    7 
    +-- See Note [GHCi unboxed tuples stack spills] in rts/StgMiscClosures.cmm.
    8 
    +
    9 
    +module Main where
    10 
    +
    11 
    +import GHC.Exts
    12 
    +import GHC.IO (IO(..))
    13 
    +import T27633c_obj
    14 
    +
    15 
    +unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
    16 
    +unIO (IO f) = f
    17 
    +
    18 
    +poke :: Int -> IO Int
    19 
    +poke x =
    20 
    +  return (x + 1)          -- line 20: initial breakpoint
    21 
    +
    22 
    +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# #)
    23 
    +scrut s0 = case unIO (poke 41) s0 of (# s1, _ #) -> mkT s1
    24 
    +{-# NOINLINE scrut #-}
    25 
    +
    26 
    +main :: IO ()
    27 
    +main = IO (\s0 -> case scrut s0 of
    28 
    +             (# 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 #) ->
    29 
    +               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
    1 
    +:load T27633c.hs
    2 
    +-- break inside poke, while the generic stg_ctoi_t frame from main's
    3 
    +-- 24-field tuple case is live on the stack
    4 
    +:break 20
    5 
    +main
    6 
    +-- step out to the small case continuation in scrut
    7 
    +:stepout
    8 
    +-- step out again: activates the breakpoint of main's tuple case
    9 
    +-- continuation BCO, entered through the generic stg_ctoi_t frame
    10 
    +:stepout
    11 
    +-- resuming re-enters the stg_ctoi_t frame; with a stale
    12 
    +-- tso->ctoi_tuple_spill_words this segfaulted
    13 
    +:continue

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

  • testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
    1 
    +{-# OPTIONS_GHC -fobject-code #-}
    2 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    3 
    +module T27633c_obj where
    4 
    +
    5 
    +import GHC.Exts
    6 
    +
    7 
    +-- Compiled to object code; returns a large unboxed tuple, so the return
    8 
    +-- into an interpreted caller goes through the native stg_ctoi_t entry code,
    9 
    +-- which reads tso->ctoi_tuple_spill_words.
    10 
    +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# #)
    11 
    +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# #)
    12 
    +{-# NOINLINE mkT #-}

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

    • —
    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/192be0b6b861725613a9be5cb1587fb8cdf68bd3 at 1788824633