Ben Gamari pushed to branch wip/stm-mvar-deadlock-backtrace at Glasgow Haskell Compiler / GHC

Commits:

24 changed files:

Changes:

  • compiler/GHC/Driver/GenerateCgIPEStub.hs
    1 1 
     module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where
    2 2
    3 
    +import Control.Applicative ((<|>))
    3 4 
     import Data.Map.Strict (Map)
    4 5 
     import qualified Data.Map.Strict as Map
    6 
    +import Data.Maybe (listToMaybe)
    5 7 
     import Data.Semigroup ((<>))
    6 8 
     import GHC.Cmm
    7 9 
     import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel)
    ... ... @@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
    10 12 
     import GHC.Cmm.Dataflow.Label
    11 13 
     import GHC.Cmm.Info.Build (emptySRT)
    12 14 
     import GHC.Cmm.Pipeline (cmmPipeline)
    15 
    +import GHC.Data.FastString (FastString, mkFastString)
    13 16 
     import GHC.Data.Stream (liftIO, liftEff)
    14 17 
     import qualified GHC.Data.Stream as Stream
    15 18 
     import GHC.Driver.Env (hsc_dflags, hsc_logger)
    ... ... @@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils
    28 31 
     import GHC.StgToCmm.CgUtils (CgStream)
    29 32 
     import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
    30 33 
     import GHC.Types.Name.Set (NonCaffySet)
    34 
    +import GHC.Types.SrcLoc (srcSpanFile)
    31 35 
     import GHC.Types.Tickish (GenTickish (SourceNote))
    32 36 
     import GHC.Unit.Types (Module, moduleName)
    33 
    -import GHC.Unit.Module (moduleNameString)
    37 
    +import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file)
    34 38 
     import qualified GHC.Utils.Logger as Logger
    35 39 
     import GHC.Utils.Outputable (ppr)
    36 40 
     import GHC.Types.Unique.DSM
    ... ... @@ -257,11 +261,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
    257 261 
     -- performance suffered considerably as a result (see #23103).
    258 262 
     lookupEstimatedTicks
    259 263 
       :: HscEnv
    264 
    +  -> ModLocation -- ^ location of the module being compiled, for IPE provenance
    260 265 
       -> Map CmmInfoTable (Maybe IpeSourceLocation)
    261 266 
       -> IPEStats
    262 267 
       -> CmmGroupSRTs
    263 268 
       -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
    264 
    -lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
    269 
    +lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts =
    265 270 
         -- Pass 2: Create an entry in the IPE map for every info table listed in
    266 271 
         -- this CmmGroupSRTs. If the info table is a stack info table and
    267 272 
         -- -finfo-table-map-with-stack is enabled, look up its estimated source
    ... ... @@ -276,19 +281,24 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
    276 281 
         dflags = hsc_dflags hsc_env
    277 282 
         platform = targetPlatform dflags
    278 283
    279 
    -    -- Pass 1: Map every label meeting the conditions described in Note
    280 
    -    -- [Stacktraces from Info Table Provenance Entries (IPE based stack
    281 
    -    -- unwinding)] to the estimated source location (also as described in the
    282 
    -    -- aformentioned note)
    284 
    +    -- Source file of the module being compiled, used to prefer current-module
    285 
    +    -- source ticks for return frames. See Note [Prefer current-module source
    286 
    +    -- ticks for return frames].
    287 
    +    mb_src_file = mkFastString <$> ml_hs_file mod_location
    288 
    +
    289 
    +    -- Pass 1: Map every label meeting the conditions described in
    290 
    +    -- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
    291 
    +    -- to the estimated source location (also as described in the aformentioned
    292 
    +    -- note).
    283 293 
         --
    284 294 
         -- Note: It's important that this remains a thunk so we do not compute this
    285 295 
         -- map if -fno-info-table-with-stack is given
    286 296 
         labelsToSources :: Map CLabel IpeSourceLocation
    287 297 
         labelsToSources =
    288 298 
           if platformTablesNextToCode platform then
    289 
    -        foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts
    299 
    +        foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts
    290 300 
           else
    291 
    -        foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts
    301 
    +        foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts
    292 302
    293 303 
         collectInfoTables
    294 304 
           :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
    ... ... @@ -331,15 +341,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
    331 341
    332 342 
     -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
    333 343 
     labelsToSourcesWithTNTC
    334 
    -  :: Map CLabel IpeSourceLocation
    344 
    +  :: Maybe FastString -- ^ source file of the module being compiled
    345 
    +  -> Map CLabel IpeSourceLocation
    335 346 
       -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
    336 347 
       -> Map CLabel IpeSourceLocation
    337 
    -labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
    348 
    +labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
    338 349 
         foldl' go acc (toBlockList cmm_graph)
    339 350 
       where
    340 351 
         go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
    341 352 
         go acc block =
    342 
    -        case (,) <$> returnFrameLabel <*> lastTickInBlock of
    353 
    +        case (,) <$> returnFrameLabel <*> bestTickInBlock of
    343 354 
               Just (clabel, src_loc) -> Map.insert clabel src_loc acc
    344 355 
               Nothing -> acc
    345 356 
           where
    ... ... @@ -351,36 +362,135 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
    351 362 
                 (CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l
    352 363 
                 _ -> Nothing
    353 364
    354 
    -        lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock)
    365 
    +        -- All SourceNotes in the block, in block order.
    366 
    +        -- See Note [Prefer current-module source ticks for return frames].
    367 
    +        bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock)
    368 
    +
    369 
    +    -- Enclosing current-module note for the whole proc (its function's own
    370 
    +    -- span), used when a return frame's own block has no current-module tick.
    371 
    +    procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
    372 
    +labelsToSourcesWithTNTC _ acc _ = acc
    373 
    +
    374 
    +{-
    375 
    +Note [Prefer current-module source ticks for return frames]
    376 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    377 
    +A return frame's source location is taken from the `SourceNote`s of the block
    378 
    +that *ends* in the frame's call (see
    379 
    +Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding]
    380 
    +above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a
    381 
    +block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`,
    382 
    +`threadDelay`, ...) and the *nearest* note — the one historically chosen — is
    383 
    +often a library note rather than the user's code. The resulting IPE entry then
    384 
    +points at the library (its file and label; see `toCgIPE` in
    385 
    +GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a
    386 
    +backtrace of a thread blocked in such a primop shows no user frames.
    387 
    +
    388 
    +For a concrete example, compile (at -O1)
    389 
    +
    390 
    +    -- Scan.hs
    391 
    +    f3 :: IO ()
    392 
    +    f3 = threadDelay 1000000 >> putStrLn "done"
    393 
    +
    394 
    +The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a
    395 
    +block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick
    396 
    +for `f3` sits only in the proc's entry block:
    397 
    +
    398 
    +    entry:                                    -- the proc's entry block
    399 
    +        //tick src<.../Base.hs:2306:5-18>
    400 
    +        //tick src<Scan.hs:13:1-43>           -- the enclosing `f3` span
    401 
    +        //tick src<.../Conc/IO.hs:(223,1)-(235,10)>
    402 
    +        ...
    403 
    +    delayBlk:                                 -- no Scan.hs note here:
    404 
    +        //tick src<.../Conc/IO.hs:232:5-13>
    405 
    +        //tick src<.../Base.hs:2268:1-9>
    406 
    +        //tick src<.../Conc/IO.hs:(232,25)-(235,10)>   -- nearest note
    407 
    +        call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8;
    408 
    +
    409 
    +Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`,
    410 
    +i.e. an internal of `threadDelay`, rather than `f3`.
    411 
    +
    412 
    +To fix this we attribute a return frame's source location in the following
    413 
    +preference order:
    414 
    +
    415 
    +  1. the nearest tick in the frame's block whose file is that of the module
    416 
    +     being compiled - the precise user call site. (When the user makes a
    417 
    +     blocking call directly, e.g. `f v = takeMVar v`, such a note is present in
    418 
    +     the call's block and this rule suffices; the `delayBlk` above has none.)
    419 
    +  2. failing that, the proc's *enclosing* current-module note (the outermost
    420 
    +     current-module `SourceNote` in the proc, i.e. its function's own span).
    421 
    +     For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to
    422 
    +     `f3` rather than to `threadDelay`'s internals.
    423 
    +  3. failing that, the nearest note of any module (the historical behaviour).
    424 
    +
    425 
    +This mirrors the same-file preference the DWARF path uses in
    426 
    +`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses
    427 
    +for closures.
    428 
    +-}
    355 429
    356 
    -        maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
    357 
    -        maybeTick _ s@(Just _) = s
    358 
    -        maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name)
    359 
    -        maybeTick _ _ = Nothing
    360 
    -labelsToSourcesWithTNTC acc _ = acc
    430 
    +-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the
    431 
    +-- source-note-bearing nodes of its block (in block order).
    432 
    +--
    433 
    +-- See Note [Prefer current-module source ticks for return frames].
    434 
    +preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation
    435 
    +preferThisFile mb_src_file procFallback nodes =
    436 
    +    nearest fromThisFile <|> procFallback <|> nearest sourceNotes
    437 
    +  where
    438 
    +    sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ]
    439 
    +    fromThisFile = case mb_src_file of
    440 
    +      Just f  -> filter ((== f) . srcSpanFile . fst) sourceNotes
    441 
    +      Nothing -> []
    442 
    +    nearest = listToMaybe . reverse
    443 
    +
    444 
    +-- | The outermost 'SourceNote' from the module being compiled across a proc's
    445 
    +-- blocks (in 'toBlockList' order, so the entry block's note — the function's own
    446 
    +-- span — comes first). Used as a fallback so inlined cross-module code is still
    447 
    +-- labelled with the enclosing user function. 'Nothing' when the proc has no
    448 
    +-- current-module note (e.g. when compiling the library itself).
    449 
    +enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation
    450 
    +enclosingThisFileTick mb_src_file blocks =
    451 
    +    listToMaybe
    452 
    +      [ (span, name)
    453 
    +      | b <- blocks
    454 
    +      , let (_, mid, _) = blockSplit b
    455 
    +      , CmmTick (SourceNote span name) <- blockToList mid
    456 
    +      , Just (srcSpanFile span) == mb_src_file ]
    361 457
    362 458 
     -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
    363 459 
     labelsToSourcesSansTNTC
    364 
    -  :: Map CLabel IpeSourceLocation
    460 
    +  :: Maybe FastString -- ^ source file of the module being compiled
    461 
    +  -> Map CLabel IpeSourceLocation
    365 462 
       -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
    366 463 
       -> Map CLabel IpeSourceLocation
    367 
    -labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) =
    464 
    +labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
    368 465 
         foldl' go acc (toBlockList cmm_graph)
    369 466 
       where
    467 
    +    -- See 'enclosingThisFileTick'.
    468 
    +    procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
    469 
    +
    370 470 
         go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
    371 
    -    go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock)
    471 
    +    go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock)
    372 472 
           where
    373 473 
             (_, middleBlock, _) = blockSplit block
    374 474
    475 
    +        -- We track the nearest preceding SourceNote from the module being
    476 
    +        -- compiled and the nearest of any module, and prefer the former (then
    477 
    +        -- the proc's enclosing current-module note) when attributing a return
    478 
    +        -- frame. See Note [Prefer current-module source ticks for return frames].
    375 479 
             collectLabels
    376 
    -          :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
    480 
    +          :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
    377 481 
               -> CmmNode O O
    378 
    -          -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
    379 
    -        collectLabels (!acc, lastTick) b =
    380 
    -          case (b, lastTick) of
    381 
    -            (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) ->
    382 
    -              (Map.insert l src_loc acc, Nothing)
    383 
    -            (CmmTick (SourceNote span name), _) ->
    384 
    -              (acc, Just (span, name))
    385 
    -            _ -> (acc, lastTick)
    386 
    -labelsToSourcesSansTNTC acc _ = acc
    482 
    +          -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
    483 
    +        collectLabels (!acc, st@(lastThis, lastAny)) b =
    484 
    +          case b of
    485 
    +            CmmStore _ (CmmLit (CmmLabel l)) _ ->
    486 
    +              case lastThis <|> procFallback <|> lastAny of
    487 
    +                Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing))
    488 
    +                Nothing      -> (acc, st)
    489 
    +            CmmTick (SourceNote span name) ->
    490 
    +              let tick = (span, name)
    491 
    +                  lastThis'
    492 
    +                    | Just (srcSpanFile span) == mb_src_file = Just tick
    493 
    +                    | otherwise                              = lastThis
    494 
    +              in (acc, (lastThis', Just tick))
    495 
    +            _ -> (acc, st)
    496 
    +labelsToSourcesSansTNTC _ acc _ = acc

  • compiler/GHC/Driver/Main/Compile.hs
    ... ... @@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do
    699 699 
                 _          ->
    700 700 
                   do
    701 701 
                   cmms <- {-# SCC "StgToCmm" #-}
    702 
    -                doCodeGen hsc_env this_mod denv tycons
    702 
    +                doCodeGen hsc_env this_mod mod_loc denv tycons
    703 703 
                     cost_centre_info
    704 704 
                     stg_binds
    705 705
    ... ... @@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly
    956 956 
     (5-10%).
    957 957 
     -}
    958 958
    959 
    -doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
    959 
    +doCodeGen :: HscEnv -> Module
    960 
    +          -> ModLocation -- ^ location of the module being compiled, used to
    961 
    +                         -- prefer current-module IPE source locations
    962 
    +          -> InfoTableProvMap -> [TyCon]
    960 963 
               -> CollectedCCs
    961 964 
               -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
    962 965 
               -> IO (CgStream CmmGroupSRTs CmmCgInfos)
    963 966 
              -- Note we produce a 'Stream' of CmmGroups, so that the
    964 967 
              -- backend can be run incrementally.  Otherwise it generates all
    965 968 
              -- the C-- up front, which has a significant space cost.
    966 
    -doCodeGen hsc_env this_mod denv tycons
    969 
    +doCodeGen hsc_env this_mod mod_location denv tycons
    967 970 
                   cost_centre_info stg_binds_w_fvs = do
    968 971 
         let dflags     = hsc_dflags hsc_env
    969 972 
             logger     = hsc_logger hsc_env
    ... ... @@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons
    1032 1035 
               -- Positions] in GHC.Stg.Debug.
    1033 1036 
               (ipes', stats') <-
    1034 1037 
                 if (gopt Opt_InfoTableMap dflags) then
    1035 
    -              liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts
    1038 
    +              liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts
    1036 1039 
                 else
    1037 1040 
                   return (ipes, stats)
    1038 1041

  • libraries/base/src/Control/Exception/Base.hs
    ... ... @@ -85,7 +85,6 @@ module Control.Exception.Base
    85 85 
          patError,
    86 86 
          noMethodBindingError,
    87 87 
          typeError,
    88 
    -     nonTermination,
    89 88 
          nestedAtomically,
    90 89 
          noMatchingContinuationPrompt
    91 90 
          ) where

  • libraries/base/src/GHC/IO/Exception.hs
    ... ... @@ -19,8 +19,8 @@
    19 19 
     --
    20 20
    21 21 
     module GHC.IO.Exception (
    22 
    -  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
    23 
    -  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
    22 
    +  BlockedIndefinitelyOnMVar(..),
    23 
    +  BlockedIndefinitelyOnSTM(..),
    24 24 
       Deadlock(..),
    25 25 
       AllocationLimitExceeded(..), allocationLimitExceeded,
    26 26 
       AssertionFailed(..),

  • libraries/ghc-internal/include/RtsIfaceSymbols.h
    ... ... @@ -15,12 +15,12 @@ CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure)
    15 15 
     CLOSURE(GHCziInternalziIOziException, stackOverflow_closure)
    16 16 
     CLOSURE(GHCziInternalziIOziException, heapOverflow_closure)
    17 17 
     CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure)
    18 
    -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure)
    19 
    -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
    18 
    +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVarError_closure)
    19 
    +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTMError_closure)
    20 20 
     CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
    21 21 
     CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
    22 22 
     CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
    23 
    -CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
    23 
    +CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure)
    24 24 
     CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
    25 25 
     CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
    26 26 
     #if defined(mingw32_HOST_OS)

  • libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
    ... ... @@ -108,7 +108,7 @@ module GHC.Internal.Control.Exception.Base (
    108 108 
             impossibleError, impossibleConstraintError,
    109 109 
             nonExhaustiveGuardsError, patError, noMethodBindingError,
    110 110 
             typeError,
    111 
    -        nonTermination, nestedAtomically, noMatchingContinuationPrompt,
    111 
    +        nonTerminationError, nestedAtomically, noMatchingContinuationPrompt,
    112 112 
       ) where
    113 113
    114 114 
     import           GHC.Internal.Base (
    ... ... @@ -448,8 +448,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s)
    448 448
    449 449
    450 450 
     -- GHC's RTS calls this
    451 
    -nonTermination :: SomeException
    452 
    -nonTermination = toException NonTermination
    451 
    +nonTerminationError :: IO ()
    452 
    +nonTerminationError = throwIO NonTermination
    453 
    +
    453 454
    454 455 
     -- GHC's RTS calls this
    455 456 
     nestedAtomically :: SomeException

  • libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
    ... ... @@ -24,8 +24,8 @@
    24 24 
     -----------------------------------------------------------------------------
    25 25
    26 26 
     module GHC.Internal.IO.Exception (
    27 
    -  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
    28 
    -  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
    27 
    +  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVarError,
    28 
    +  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTMError,
    29 29 
       Deadlock(..),
    30 30 
       AllocationLimitExceeded(..), allocationLimitExceeded,
    31 31 
       AssertionFailed(..),
    ... ... @@ -84,8 +84,8 @@ instance Exception BlockedIndefinitelyOnMVar
    84 84 
     instance Show BlockedIndefinitelyOnMVar where
    85 85 
         showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
    86 86
    87 
    -blockedIndefinitelyOnMVar :: SomeException -- for the RTS
    88 
    -blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
    87 
    +blockedIndefinitelyOnMVarError :: IO () -- for the RTS
    88 
    +blockedIndefinitelyOnMVarError = throwIO BlockedIndefinitelyOnMVar
    89 89
    90 90 
     -----
    91 91
    ... ... @@ -100,8 +100,8 @@ instance Exception BlockedIndefinitelyOnSTM
    100 100 
     instance Show BlockedIndefinitelyOnSTM where
    101 101 
         showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
    102 102
    103 
    -blockedIndefinitelyOnSTM :: SomeException -- for the RTS
    104 
    -blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
    103 
    +blockedIndefinitelyOnSTMError :: IO () -- for the RTS
    104 
    +blockedIndefinitelyOnSTMError = throwIO BlockedIndefinitelyOnSTM
    105 105
    106 106 
     -----
    107 107

  • rts/Prelude.h
    ... ... @@ -53,12 +53,12 @@ extern StgClosure ZCMain_main_closure;
    53 53 
     #define stackOverflow_closure     ghc_hs_iface->stackOverflow_closure
    54 54 
     #define heapOverflow_closure      ghc_hs_iface->heapOverflow_closure
    55 55 
     #define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure
    56 
    -#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure
    57 
    -#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure
    56 
    +#define blockedIndefinitelyOnMVarError_closure ghc_hs_iface->blockedIndefinitelyOnMVarError_closure
    57 
    +#define blockedIndefinitelyOnSTMError_closure ghc_hs_iface->blockedIndefinitelyOnSTMError_closure
    58 58 
     #define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
    59 59 
     #define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
    60 60 
     #define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
    61 
    -#define nonTermination_closure    ghc_hs_iface->nonTermination_closure
    61 
    +#define nonTerminationError_closure    ghc_hs_iface->nonTerminationError_closure
    62 62 
     #define nestedAtomically_closure  ghc_hs_iface->nestedAtomically_closure
    63 63 
     #define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
    64 64 
     #define underflowException_closure ghc_hs_iface->underflowException_closure

  • rts/RaiseAsync.c
    ... ... @@ -87,6 +87,55 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
    87 87 
         throwToSingleThreaded__ (cap, tso, NULL, false, stop_here);
    88 88 
     }
    89 89
    90 
    +/* -----------------------------------------------------------------------------
    91 
    +   scheduleRaiseViaIO
    92 
    +
    93 
    +   Schedule `tso` to raise an exception by running `io_action`, an IO () that
    94 
    +   performs `throwIO`.  Unlike throwToSingleThreaded (which injects an exception
    95 
    +   *value* via raiseAsync), the exception is raised by throwIO *within* the
    96 
    +   thread, so it acquires a backtrace of the thread's stack.  This is used by
    97 
    +   resurrectThreads to deliver the "blocked indefinitely" exceptions
    98 
    +   (BlockedIndefinitelyOnMVar, BlockedIndefinitelyOnSTM, NonTermination).
    99 
    +
    100 
    +   We push a "run this IO action" frame on top of the thread's existing
    101 
    +   (suspended) stack and make it runnable; when the thread runs, throwIO raises
    102 
    +   the exception and its own stack unwinding handles any CATCH_FRAME /
    103 
    +   ATOMICALLY_FRAME (e.g. aborting a blocked STM transaction).
    104 
    +
    105 
    +   removeFromQueues takes care of unlinking the thread from any blocking queue
    106 
    +   (notably the MVar blocked queue) and appends it to the run queue.  As with
    107 
    +   throwToSingleThreaded, the caller must own the TSO (e.g. hold all
    108 
    +   capabilities during GC); in particular this relies on the thread not being
    109 
    +   scheduled between removeFromQueues' enqueue and our stack push.
    110 
    +   -------------------------------------------------------------------------- */
    111 
    +
    112 
    +void
    113 
    +scheduleRaiseViaIO (Capability *cap, StgTSO *tso, StgClosure *io_action)
    114 
    +{
    115 
    +    // Thread already dead?
    116 
    +    if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
    117 
    +        return;
    118 
    +    }
    119 
    +
    120 
    +    // Unlink from any blocking queues; sets why_blocked = NotBlocked and
    121 
    +    // appends the thread to the run queue.
    122 
    +    removeFromQueues(cap, tso);
    123 
    +
    124 
    +    StgStack *stack = tso->stackobj;
    125 
    +
    126 
    +    // We are about to mutate the stack, so dirty it for the GC write barrier
    127 
    +    // (resurrectThreads runs right after GC).
    128 
    +    dirty_TSO(cap, tso);
    129 
    +    dirty_STACK(cap, stack);
    130 
    +
    131 
    +    // Push a frame that enters `io_action` and applies the resulting IO action
    132 
    +    // to the void (RealWorld) argument:  [stg_enter_info, io_action, stg_ap_v_info]
    133 
    +    stack->sp -= 3;
    134 
    +    stack->sp[0] = (W_)&stg_enter_info;
    135 
    +    stack->sp[1] = (W_)io_action;
    136 
    +    stack->sp[2] = (W_)&stg_ap_v_info;
    137 
    +}
    138 
    +
    90 139 
     /* -----------------------------------------------------------------------------
    91 140 
        throwToSelf
    92 141

  • rts/RaiseAsync.h
    ... ... @@ -38,6 +38,10 @@ void suspendComputation (Capability *cap,
    38 38 
                              StgTSO *tso,
    39 39 
                              StgUpdateFrame *stop_here);
    40 40
    41 
    +void scheduleRaiseViaIO (Capability *cap,
    42 
    +                         StgTSO *tso,
    43 
    +                         StgClosure *io_action);
    44 
    +
    41 45 
     MessageThrowTo *throwTo (Capability *cap,      // the Capability we hold
    42 46 
                              StgTSO *source,
    43 47 
                              StgTSO *target,

  • rts/RtsStartup.c
    ... ... @@ -192,9 +192,9 @@ static void initBuiltinGcRoots(void)
    192 192 
         getStablePtr((StgPtr)stackOverflow_closure);
    193 193 
         getStablePtr((StgPtr)heapOverflow_closure);
    194 194 
         getStablePtr((StgPtr)unpackCString_closure);
    195 
    -    getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
    196 
    -    getStablePtr((StgPtr)nonTermination_closure);
    197 
    -    getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
    195 
    +    getStablePtr((StgPtr)blockedIndefinitelyOnMVarError_closure);
    196 
    +    getStablePtr((StgPtr)nonTerminationError_closure);
    197 
    +    getStablePtr((StgPtr)blockedIndefinitelyOnSTMError_closure);
    198 198 
         getStablePtr((StgPtr)allocationLimitExceeded_closure);
    199 199 
         getStablePtr((StgPtr)cannotCompactFunction_closure);
    200 200 
         getStablePtr((StgPtr)cannotCompactPinned_closure);

  • rts/Schedule.c
    ... ... @@ -3309,16 +3309,16 @@ resurrectThreads (StgTSO *threads)
    3309 3309 
             case BlockedOnMVar:
    3310 3310 
             case BlockedOnMVarRead:
    3311 3311 
                 /* Called by GC - sched_mutex lock is currently held. */
    3312 
    -            throwToSingleThreaded(cap, tso,
    3313 
    -                                  (StgClosure *)blockedIndefinitelyOnMVar_closure);
    3312 
    +            scheduleRaiseViaIO(cap, tso,
    3313 
    +                               (StgClosure *)blockedIndefinitelyOnMVarError_closure);
    3314 3314 
                 break;
    3315 3315 
             case BlockedOnBlackHole:
    3316 
    -            throwToSingleThreaded(cap, tso,
    3317 
    -                                  (StgClosure *)nonTermination_closure);
    3316 
    +            scheduleRaiseViaIO(cap, tso,
    3317 
    +                               (StgClosure *)nonTerminationError_closure);
    3318 3318 
                 break;
    3319 3319 
             case BlockedOnSTM:
    3320 
    -            throwToSingleThreaded(cap, tso,
    3321 
    -                                  (StgClosure *)blockedIndefinitelyOnSTM_closure);
    3320 
    +            scheduleRaiseViaIO(cap, tso,
    3321 
    +                               (StgClosure *)blockedIndefinitelyOnSTMError_closure);
    3322 3322 
                 break;
    3323 3323 
             case NotBlocked:
    3324 3324 
                 /* This might happen if the thread was blocked on a black hole

  • rts/include/rts/RtsToHsIface.h
    ... ... @@ -20,12 +20,12 @@ typedef struct {
    20 20 
         StgClosure *stackOverflow_closure;  // GHC.Internal.IO.Exception.stackOverflow_closure
    21 21 
         StgClosure *heapOverflow_closure;  // GHC.Internal.IO.Exception.heapOverflow_closure
    22 22 
         StgClosure *allocationLimitExceeded_closure;  // GHC.Internal.IO.Exception.allocationLimitExceeded_closure
    23 
    -    StgClosure *blockedIndefinitelyOnMVar_closure;  // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure
    24 
    -    StgClosure *blockedIndefinitelyOnSTM_closure;  // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure
    23 
    +    StgClosure *blockedIndefinitelyOnMVarError_closure;  // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVarError_closure
    24 
    +    StgClosure *blockedIndefinitelyOnSTMError_closure;  // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTMError_closure
    25 25 
         StgClosure *cannotCompactFunction_closure;  // GHC.Internal.IO.Exception.cannotCompactFunction_closure
    26 26 
         StgClosure *cannotCompactPinned_closure;  // GHC.Internal.IO.Exception.cannotCompactPinned_closure
    27 27 
         StgClosure *cannotCompactMutable_closure;  // GHC.Internal.IO.Exception.cannotCompactMutable_closure
    28 
    -    StgClosure *nonTermination_closure;  // GHC.Internal.Control.Exception.Base.nonTermination_closure
    28 
    +    StgClosure *nonTerminationError_closure;  // GHC.Internal.Control.Exception.Base.nonTerminationError_closure
    29 29 
         StgClosure *nestedAtomically_closure;  // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
    30 30 
         StgClosure *noMatchingContinuationPrompt_closure;  // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
    31 31 
         StgClosure *blockedOnBadFD_closure;  // GHC.Internal.Event.Thread.blockedOnBadFD_closure

  • testsuite/tests/rts/LoopBacktrace.hs
    1 
    +{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-}
    2 
    +
    3 
    +import GHC.Exception.Backtrace.Experimental
    4 
    +
    5 
    +x :: Integer
    6 
    +x = x + 1
    7 
    +
    8 
    +testing :: IO ()
    9 
    +testing = do
    10 
    +  putStrLn "hello"
    11 
    +  print x
    12 
    +  putStrLn "world"
    13 
    +
    14 
    +main :: IO ()
    15 
    +main = do
    16 
    +  setBacktraceMechanismState IPEBacktrace True
    17 
    +  testing

  • testsuite/tests/rts/LoopBacktrace.stderr
    1 
    +LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
    2 
    +
    3 
    +<<loop>>
    4 
    +
    5 
    +IPE backtrace:
    6 
    +  GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25))
    7 
    +  GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56)
    8 
    +  GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53))
    9 
    +  GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36)
    10 
    +  Cmm$rts/HeapStackCheck.cmm. (:)
    11 
    +  GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52))
    12 
    +  Cmm$rts/Updates.cmm. (:)
    13 
    +  Main.x (LoopBacktrace.hs:6:1-9)
    14 
    +  GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21)
    15 
    +  GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37)
    16 
    +  GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72)
    17 
    +  Cmm$rts/Exception.cmm. (:)
    18 
    +  Cmm$rts/StgStartup.cmm. (:)
    19 
    +HasCallStack backtrace:
    20 
    +  throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base
    21 
    +

  • testsuite/tests/rts/LoopBacktrace.stdout
    1 
    +hello

  • testsuite/tests/rts/MVarDeadlockBacktrace.hs
    1 
    +{-# OPTIONS_GHC -finfo-table-map #-}
    2 
    +
    3 
    +-- | Check that a @BlockedIndefinitelyOnMVar@ deadlock exception carries a
    4 
    +-- backtrace mentioning the blocking site in this module.
    5 
    +import Control.Concurrent.MVar
    6 
    +import GHC.Exception.Backtrace.Experimental
    7 
    +
    8 
    +main :: IO ()
    9 
    +main = do
    10 
    +  setBacktraceMechanismState IPEBacktrace True
    11 
    +  mv <- newEmptyMVar :: IO (MVar ())
    12 
    +  x <- takeMVar mv
    13 
    +  print x

  • testsuite/tests/rts/MVarDeadlockBacktrace.stderr
    1 
    +MVarDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar:
    2 
    +  Main.main (MVarDeadlockBacktrace.hs:16:3-36)

  • testsuite/tests/rts/STMDeadlockBacktrace.hs
    1 
    +{-# OPTIONS_GHC -finfo-table-map #-}
    2 
    +
    3 
    +-- | Check that a @BlockedIndefinitelyOnSTM@ deadlock exception carries a
    4 
    +-- backtrace mentioning the blocking site in this module.
    5 
    +import GHC.Conc (atomically, retry)
    6 
    +import GHC.Exception.Backtrace.Experimental
    7 
    +
    8 
    +main :: IO ()
    9 
    +main = do
    10 
    +  setBacktraceMechanismState IPEBacktrace True
    11 
    +  x <- atomically retry :: IO ()
    12 
    +  print x

  • testsuite/tests/rts/STMDeadlockBacktrace.stderr
    1 
    +STMDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM:
    2 
    +  Main.main (STMDeadlockBacktrace.hs:16:3-32)

  • testsuite/tests/rts/all.T
    ... ... @@ -687,3 +687,11 @@ test('ClosureTable',
    687 687 
          ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
    688 688
    689 689 
     test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
    690 
    +
    691 
    +test('LoopBacktrace', [exit_code(1)], compile_and_run, [''])
    692 
    +
    693 
    +deadlock_backtrace_norm = grep_errmsg(r'(Uncaught exception|Main\.)')
    694 
    +test('MVarDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
    695 
    +     compile_and_run, ['-O'])
    696 
    +test('STMDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
    697 
    +     compile_and_run, ['-O'])

  • testsuite/tests/rts/ipe/T27408.hs
    1 
    +module Main where
    2 
    +
    3 
    +import GHC.Stack.CloneStack (StackEntry(..), cloneMyStack, decode)
    4 
    +
    5 
    +userFunction :: IO [StackEntry]
    6 
    +userFunction = do
    7 
    +  putStr ""
    8 
    +  stk <- cloneMyStack
    9 
    +  putStr ""
    10 
    +  es <- decode stk
    11 
    +  putStr ""
    12 
    +  return es
    13 
    +
    14 
    +main :: IO ()
    15 
    +main = do
    16 
    +  entries <- userFunction
    17 
    +  let ours = filter ((== "Main") . moduleName) entries
    18 
    +  mapM_ (\e -> putStrLn (moduleName e ++ "\t" ++ functionName e)) ours

  • testsuite/tests/rts/ipe/T27408.stdout
    1 
    +Main
    2 
    +Main	main
    3 
    +Main	userFunction

  • testsuite/tests/rts/ipe/all.T
    ... ... @@ -4,6 +4,16 @@ def noCapabilityOutputFilter(s):
    4 4
    5 5 
     test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src, omit_ghci], compile_and_run, ['ipe_lib.c'])
    6 6
    7 
    +# Return frames whose Cmm block is dominated by inlined library ticks (e.g. the
    8 
    +# (>>)/(>>=) of a user do-block at -O) should still be attributed to the user's
    9 
    +# module. See Note [Prefer current-module source ticks for return frames] in
    10 
    +# GHC.Driver.GenerateCgIPEStub.
    11 
    +test('T27408',
    12 
    +     [ omit_ghci          # cloneMyStack# is not available in ghci
    13 
    +     , js_broken(22261)   # cloneMyStack# not yet implemented in the JS backend
    14 
    +     ],
    15 
    +     compile_and_run, ['-O1 -finfo-table-map -g3'])
    16 
    +
    7 17 
     # Manually create IPE entries and dump them to event log (stderr).
    8 18 
     test('ipeEventLog',
    9 19 
          [ c_src,

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help