- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/sol/pp-set-ghc-version] Edit pp-set-ghc-version
by Simon Hengel (＠sol) 20 Jun '26

20 Jun '26

Simon Hengel pushed to branch wip/sol/pp-set-ghc-version at Glasgow Haskell Compiler / GHC Commits: 2c3b1461 by Simon Hengel at 2026-06-20T14:01:11+00:00 Edit pp-set-ghc-version - - - - - 1 changed file: - changelog.d/pp-set-ghc-version Changes: ===================================== changelog.d/pp-set-ghc-version ===================================== @@ -1,4 +1,5 @@ section: compiler synopsis: Set the environment variable GHC_VERSION when calling custom pre-processors issues: #25952 -mrs: +mrs: !16224 +Description: Set the environment variable GHC_VERSION to the current GHC version when invoking custom pre-processors, so that pre-processors can emit backwards compatible code without relying on CPP. \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c3b14612af08b540729dd57ba6d179… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c3b14612af08b540729dd57ba6d179… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sol/pp-set-ghc-version
by Simon Hengel (＠sol) 20 Jun '26

20 Jun '26

Simon Hengel pushed new branch wip/sol/pp-set-ghc-version at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/pp-set-ghc-version You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/dcoutts/io-manager-tidy] Add missing updateRemembSetPushClosure in poll I/O manager
by Duncan Coutts (＠dcoutts) 20 Jun '26

20 Jun '26

Duncan Coutts pushed to branch wip/dcoutts/io-manager-tidy at Glasgow Haskell Compiler / GHC Commits: 649ae993 by Duncan Coutts at 2026-06-19T10:42:12+01:00 Add missing updateRemembSetPushClosure in poll I/O manager For the non-moving GC. - - - - - 1 changed file: - rts/posix/Poll.c Changes: ===================================== rts/posix/Poll.c ===================================== @@ -222,6 +222,13 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso) * status, as that is done by removeFromQueues (in the throwTo* functions). */ tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + + /* We are in the TSO case, where the aiop was only reachable from the TSO + * itself, and thus it is now no longer be reachable at all. + */ + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(cap, (StgClosure *)aiop); + } } @@ -279,7 +286,6 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) raiseAsync(iomgr->cap, tso, (StgClosure *)blockedOnBadFD_closure, false, NULL); - break; } else { /* We should be guaranteed that the tso is still on the same * cap because the tso was not on the run queue of any cap and @@ -290,6 +296,12 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) tso->_link = END_TSO_QUEUE; pushOnRunQueue(iomgr->cap, tso); } + /* For the TSO case, the aiop was only reachable from the TSO + * itself, and thus it is now no longer be reachable at all. + */ + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(cap, (StgClosure *)aiop); + } break; } case NotifyMVar: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/649ae99352b9a442236b805ad0162a6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/649ae99352b9a442236b805ad0162a6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sol/json-message-ghc-9.14-backport
by Simon Hengel (＠sol) 20 Jun '26

20 Jun '26

Simon Hengel pushed new branch wip/sol/json-message-ghc-9.14-backport at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/json-message-ghc-9.14-bac… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ipe-return-prefer-current-mod] compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 20 Jun '26

20 Jun '26

Ben Gamari pushed to branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC Commits: e76fce94 by Ben Gamari at 2026-06-19T18:26:19-04:00 compiler/ipe: Prefer source ticks in current module for return frames Previously we would simply attribute return frames to the nearest enclosing tick in the calling frame. However, this will very frequently produce unhelpful results (e.g. pointing to `(>>)` rather than the calling function). - - - - - 2 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main/Compile.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -1,7 +1,9 @@ module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where +import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe) import Data.Semigroup ((<>)) import GHC.Cmm import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel) @@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList) import GHC.Cmm.Dataflow.Label import GHC.Cmm.Info.Build (emptySRT) import GHC.Cmm.Pipeline (cmmPipeline) +import GHC.Data.FastString (FastString, mkFastString) import GHC.Data.Stream (liftIO, liftEff) import qualified GHC.Data.Stream as Stream import GHC.Driver.Env (hsc_dflags, hsc_logger) @@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.CgUtils (CgStream) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) +import GHC.Types.SrcLoc (srcSpanFile) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module, moduleName) -import GHC.Unit.Module (moduleNameString) +import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file) import qualified GHC.Utils.Logger as Logger import GHC.Utils.Outputable (ppr) import GHC.Types.Unique.DSM @@ -257,11 +261,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW -- performance suffered considerably as a result (see #23103). lookupEstimatedTicks :: HscEnv + -> ModLocation -- ^ location of the module being compiled, for IPE provenance -> Map CmmInfoTable (Maybe IpeSourceLocation) -> IPEStats -> CmmGroupSRTs -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) -lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = +lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts = -- Pass 2: Create an entry in the IPE map for every info table listed in -- this CmmGroupSRTs. If the info table is a stack info table and -- -finfo-table-map-with-stack is enabled, look up its estimated source @@ -276,19 +281,24 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = dflags = hsc_dflags hsc_env platform = targetPlatform dflags - -- Pass 1: Map every label meeting the conditions described in Note - -- [Stacktraces from Info Table Provenance Entries (IPE based stack - -- unwinding)] to the estimated source location (also as described in the - -- aformentioned note) + -- Source file of the module being compiled, used to prefer current-module + -- source ticks for return frames. See Note [Prefer current-module source + -- ticks for return frames]. + mb_src_file = mkFastString <$> ml_hs_file mod_location + + -- Pass 1: Map every label meeting the conditions described in + -- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] + -- to the estimated source location (also as described in the aformentioned + -- note). -- -- Note: It's important that this remains a thunk so we do not compute this -- map if -fno-info-table-with-stack is given labelsToSources :: Map CLabel IpeSourceLocation labelsToSources = if platformTablesNextToCode platform then - foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts else - foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) @@ -331,15 +341,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesWithTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation go acc block = - case (,) <$> returnFrameLabel <*> lastTickInBlock of + case (,) <$> returnFrameLabel <*> bestTickInBlock of Just (clabel, src_loc) -> Map.insert clabel src_loc acc Nothing -> acc where @@ -351,36 +362,135 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = (CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l _ -> Nothing - lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock) + -- All SourceNotes in the block, in block order. + -- See Note [Prefer current-module source ticks for return frames]. + bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock) + + -- Enclosing current-module note for the whole proc (its function's own + -- span), used when a return frame's own block has no current-module tick. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) +labelsToSourcesWithTNTC _ acc _ = acc + +{- +Note [Prefer current-module source ticks for return frames] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A return frame's source location is taken from the `SourceNote`s of the block +that *ends* in the frame's call (see +Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding] +above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a +block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`, +`threadDelay`, ...) and the *nearest* note — the one historically chosen — is +often a library note rather than the user's code. The resulting IPE entry then +points at the library (its file and label; see `toCgIPE` in +GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a +backtrace of a thread blocked in such a primop shows no user frames. + +For a concrete example, compile (at -O1) + + -- Scan.hs + f3 :: IO () + f3 = threadDelay 1000000 >> putStrLn "done" + +The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a +block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick +for `f3` sits only in the proc's entry block: + + entry: -- the proc's entry block + //tick src<.../Base.hs:2306:5-18> + //tick src<Scan.hs:13:1-43> -- the enclosing `f3` span + //tick src<.../Conc/IO.hs:(223,1)-(235,10)> + ... + delayBlk: -- no Scan.hs note here: + //tick src<.../Conc/IO.hs:232:5-13> + //tick src<.../Base.hs:2268:1-9> + //tick src<.../Conc/IO.hs:(232,25)-(235,10)> -- nearest note + call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8; + +Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`, +i.e. an internal of `threadDelay`, rather than `f3`. + +To fix this we attribute a return frame's source location in the following +preference order: + + 1. the nearest tick in the frame's block whose file is that of the module + being compiled - the precise user call site. (When the user makes a + blocking call directly, e.g. `f v = takeMVar v`, such a note is present in + the call's block and this rule suffices; the `delayBlk` above has none.) + 2. failing that, the proc's *enclosing* current-module note (the outermost + current-module `SourceNote` in the proc, i.e. its function's own span). + For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to + `f3` rather than to `threadDelay`'s internals. + 3. failing that, the nearest note of any module (the historical behaviour). + +This mirrors the same-file preference the DWARF path uses in +`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses +for closures. +-} - maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation - maybeTick _ s@(Just _) = s - maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name) - maybeTick _ _ = Nothing -labelsToSourcesWithTNTC acc _ = acc +-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the +-- source-note-bearing nodes of its block (in block order). +-- +-- See Note [Prefer current-module source ticks for return frames]. +preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation +preferThisFile mb_src_file procFallback nodes = + nearest fromThisFile <|> procFallback <|> nearest sourceNotes + where + sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ] + fromThisFile = case mb_src_file of + Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes + Nothing -> [] + nearest = listToMaybe . reverse + +-- | The outermost 'SourceNote' from the module being compiled across a proc's +-- blocks (in 'toBlockList' order, so the entry block's note — the function's own +-- span — comes first). Used as a fallback so inlined cross-module code is still +-- labelled with the enclosing user function. 'Nothing' when the proc has no +-- current-module note (e.g. when compiling the library itself). +enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation +enclosingThisFileTick mb_src_file blocks = + listToMaybe + [ (span, name) + | b <- blocks + , let (_, mid, _) = blockSplit b + , CmmTick (SourceNote span name) <- blockToList mid + , Just (srcSpanFile span) == mb_src_file ] -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesSansTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where + -- See 'enclosingThisFileTick'. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) + go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation - go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock) + go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock) where (_, middleBlock, _) = blockSplit block + -- We track the nearest preceding SourceNote from the module being + -- compiled and the nearest of any module, and prefer the former (then + -- the proc's enclosing current-module note) when attributing a return + -- frame. See Note [Prefer current-module source ticks for return frames]. collectLabels - :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) + :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) -> CmmNode O O - -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) - collectLabels (!acc, lastTick) b = - case (b, lastTick) of - (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) -> - (Map.insert l src_loc acc, Nothing) - (CmmTick (SourceNote span name), _) -> - (acc, Just (span, name)) - _ -> (acc, lastTick) -labelsToSourcesSansTNTC acc _ = acc + -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) + collectLabels (!acc, st@(lastThis, lastAny)) b = + case b of + CmmStore _ (CmmLit (CmmLabel l)) _ -> + case lastThis <|> procFallback <|> lastAny of + Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing)) + Nothing -> (acc, st) + CmmTick (SourceNote span name) -> + let tick = (span, name) + lastThis' + | Just (srcSpanFile span) == mb_src_file = Just tick + | otherwise = lastThis + in (acc, (lastThis', Just tick)) + _ -> (acc, st) +labelsToSourcesSansTNTC _ acc _ = acc ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do _ -> do cmms <- {-# SCC "StgToCmm" #-} - doCodeGen hsc_env this_mod denv tycons + doCodeGen hsc_env this_mod mod_loc denv tycons cost_centre_info stg_binds @@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly (5-10%). -} -doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] +doCodeGen :: HscEnv -> Module + -> ModLocation -- ^ location of the module being compiled, used to + -- prefer current-module IPE source locations + -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> IO (CgStream CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -doCodeGen hsc_env this_mod denv tycons +doCodeGen hsc_env this_mod mod_location denv tycons cost_centre_info stg_binds_w_fvs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons -- Positions] in GHC.Stg.Debug. (ipes', stats') <- if (gopt Opt_InfoTableMap dflags) then - liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts + liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts else return (ipes, stats) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e76fce946e90fa2cbb8dd94222715a5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e76fce946e90fa2cbb8dd94222715a5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ipe-return-prefer-current-mod] compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 20 Jun '26

20 Jun '26

Ben Gamari pushed to branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC Commits: 22b12ced by Ben Gamari at 2026-06-19T18:24:08-04:00 compiler/ipe: Prefer source ticks in current module for return frames Previously we would simply attribute return frames to the nearest enclosing tick in the calling frame. However, this will very frequently produce unhelpful results (e.g. pointing to `(>>)` rather than the calling function). - - - - - 2 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main/Compile.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -1,7 +1,9 @@ module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where +import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe) import Data.Semigroup ((<>)) import GHC.Cmm import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel) @@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList) import GHC.Cmm.Dataflow.Label import GHC.Cmm.Info.Build (emptySRT) import GHC.Cmm.Pipeline (cmmPipeline) +import GHC.Data.FastString (FastString, mkFastString) import GHC.Data.Stream (liftIO, liftEff) import qualified GHC.Data.Stream as Stream import GHC.Driver.Env (hsc_dflags, hsc_logger) @@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.CgUtils (CgStream) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) +import GHC.Types.SrcLoc (srcSpanFile) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module, moduleName) -import GHC.Unit.Module (moduleNameString) +import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file) import qualified GHC.Utils.Logger as Logger import GHC.Utils.Outputable (ppr) import GHC.Types.Unique.DSM @@ -257,11 +261,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW -- performance suffered considerably as a result (see #23103). lookupEstimatedTicks :: HscEnv + -> ModLocation -- ^ location of the module being compiled, for IPE provenance -> Map CmmInfoTable (Maybe IpeSourceLocation) -> IPEStats -> CmmGroupSRTs -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) -lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = +lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts = -- Pass 2: Create an entry in the IPE map for every info table listed in -- this CmmGroupSRTs. If the info table is a stack info table and -- -finfo-table-map-with-stack is enabled, look up its estimated source @@ -276,6 +281,11 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = dflags = hsc_dflags hsc_env platform = targetPlatform dflags + -- Source file of the module being compiled, used to prefer current-module + -- source ticks for return frames. See Note [Prefer current-module source + -- ticks for return frames]. + mb_src_file = mkFastString <$> ml_hs_file mod_location + -- Pass 1: Map every label meeting the conditions described in Note -- [Stacktraces from Info Table Provenance Entries (IPE based stack -- unwinding)] to the estimated source location (also as described in the @@ -286,9 +296,9 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = labelsToSources :: Map CLabel IpeSourceLocation labelsToSources = if platformTablesNextToCode platform then - foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts else - foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) @@ -331,15 +341,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesWithTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation go acc block = - case (,) <$> returnFrameLabel <*> lastTickInBlock of + case (,) <$> returnFrameLabel <*> bestTickInBlock of Just (clabel, src_loc) -> Map.insert clabel src_loc acc Nothing -> acc where @@ -351,36 +362,134 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = (CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l _ -> Nothing - lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock) + -- All SourceNotes in the block, in block order. + -- See Note [Prefer current-module source ticks for return frames]. + bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock) + + -- Enclosing current-module note for the whole proc (its function's own + -- span), used when a return frame's own block has no current-module tick. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) +labelsToSourcesWithTNTC _ acc _ = acc + +{- +Note [Prefer current-module source ticks for return frames] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A return frame's source location is taken from the `SourceNote`s of the block +that *ends* in the frame's call (see Note [Stacktraces from Info Table Provenance +Entries...] above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a +block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`, +`threadDelay`, ...) and the *nearest* note — the one historically chosen — is +often a library note rather than the user's code. The resulting IPE entry then +points at the library (its file and label; see `toCgIPE` in +GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a +backtrace of a thread blocked in such a primop shows no user frames. + +For a concrete example, compile (at -O1) + + -- Scan.hs + f3 :: IO () + f3 = threadDelay 1000000 >> putStrLn "done" + +The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a +block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick +for `f3` sits only in the proc's entry block: + + entry: -- the proc's entry block + //tick src<.../Base.hs:2306:5-18> + //tick src<Scan.hs:13:1-43> -- the enclosing `f3` span + //tick src<.../Conc/IO.hs:(223,1)-(235,10)> + ... + delayBlk: -- no Scan.hs note here: + //tick src<.../Conc/IO.hs:232:5-13> + //tick src<.../Base.hs:2268:1-9> + //tick src<.../Conc/IO.hs:(232,25)-(235,10)> -- nearest note + call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8; + +Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`, +i.e. an internal of `threadDelay`, rather than `f3`. + +To fix this we attribute a return frame's source location in the following +preference order: + + 1. the nearest tick in the frame's block whose file is that of the module + being compiled - the precise user call site. (When the user makes a + blocking call directly, e.g. `f v = takeMVar v`, such a note is present in + the call's block and this rule suffices; the `delayBlk` above has none.) + 2. failing that, the proc's *enclosing* current-module note (the outermost + current-module `SourceNote` in the proc, i.e. its function's own span). + For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to + `f3` rather than to `threadDelay`'s internals. + 3. failing that, the nearest note of any module (the historical behaviour). + +This mirrors the same-file preference the DWARF path uses in +`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses +for closures. +-} - maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation - maybeTick _ s@(Just _) = s - maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name) - maybeTick _ _ = Nothing -labelsToSourcesWithTNTC acc _ = acc +-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the +-- source-note-bearing nodes of its block (in block order). +-- +-- See Note [Prefer current-module source ticks for return frames]. +preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation +preferThisFile mb_src_file procFallback nodes = + nearest fromThisFile <|> procFallback <|> nearest sourceNotes + where + sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ] + fromThisFile = case mb_src_file of + Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes + Nothing -> [] + nearest = listToMaybe . reverse + +-- | The outermost 'SourceNote' from the module being compiled across a proc's +-- blocks (in 'toBlockList' order, so the entry block's note — the function's own +-- span — comes first). Used as a fallback so inlined cross-module code is still +-- labelled with the enclosing user function. 'Nothing' when the proc has no +-- current-module note (e.g. when compiling the library itself). +enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation +enclosingThisFileTick mb_src_file blocks = + listToMaybe + [ (span, name) + | b <- blocks + , let (_, mid, _) = blockSplit b + , CmmTick (SourceNote span name) <- blockToList mid + , Just (srcSpanFile span) == mb_src_file ] -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesSansTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where + -- See 'enclosingThisFileTick'. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) + go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation - go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock) + go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock) where (_, middleBlock, _) = blockSplit block + -- We track the nearest preceding SourceNote from the module being + -- compiled and the nearest of any module, and prefer the former (then + -- the proc's enclosing current-module note) when attributing a return + -- frame. See Note [Prefer current-module source ticks for return frames]. collectLabels - :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) + :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) -> CmmNode O O - -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) - collectLabels (!acc, lastTick) b = - case (b, lastTick) of - (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) -> - (Map.insert l src_loc acc, Nothing) - (CmmTick (SourceNote span name), _) -> - (acc, Just (span, name)) - _ -> (acc, lastTick) -labelsToSourcesSansTNTC acc _ = acc + -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) + collectLabels (!acc, st@(lastThis, lastAny)) b = + case b of + CmmStore _ (CmmLit (CmmLabel l)) _ -> + case lastThis <|> procFallback <|> lastAny of + Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing)) + Nothing -> (acc, st) + CmmTick (SourceNote span name) -> + let tick = (span, name) + lastThis' + | Just (srcSpanFile span) == mb_src_file = Just tick + | otherwise = lastThis + in (acc, (lastThis', Just tick)) + _ -> (acc, st) +labelsToSourcesSansTNTC _ acc _ = acc ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do _ -> do cmms <- {-# SCC "StgToCmm" #-} - doCodeGen hsc_env this_mod denv tycons + doCodeGen hsc_env this_mod mod_loc denv tycons cost_centre_info stg_binds @@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly (5-10%). -} -doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] +doCodeGen :: HscEnv -> Module + -> ModLocation -- ^ location of the module being compiled, used to + -- prefer current-module IPE source locations + -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> IO (CgStream CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -doCodeGen hsc_env this_mod denv tycons +doCodeGen hsc_env this_mod mod_location denv tycons cost_centre_info stg_binds_w_fvs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons -- Positions] in GHC.Stg.Debug. (ipes', stats') <- if (gopt Opt_InfoTableMap dflags) then - liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts + liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts else return (ipes, stats) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22b12cedff38c154d0959199da4e5ab… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22b12cedff38c154d0959199da4e5ab… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ipe-return-prefer-current-mod] compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 20 Jun '26

20 Jun '26

Ben Gamari pushed to branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC Commits: ab46ad97 by Ben Gamari at 2026-06-19T18:08:40-04:00 compiler/ipe: Prefer source ticks in current module for return frames Previously we would simply attribute return frames to the nearest enclosing tick in the calling frame. However, this will very frequently produce unhelpful results (e.g. pointing to `(>>)` rather than the calling function). - - - - - 2 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main/Compile.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -1,7 +1,9 @@ module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where +import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe) import Data.Semigroup ((<>)) import GHC.Cmm import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel) @@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList) import GHC.Cmm.Dataflow.Label import GHC.Cmm.Info.Build (emptySRT) import GHC.Cmm.Pipeline (cmmPipeline) +import GHC.Data.FastString (FastString, mkFastString) import GHC.Data.Stream (liftIO, liftEff) import qualified GHC.Data.Stream as Stream import GHC.Driver.Env (hsc_dflags, hsc_logger) @@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.CgUtils (CgStream) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) +import GHC.Types.SrcLoc (srcSpanFile) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module, moduleName) -import GHC.Unit.Module (moduleNameString) +import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file) import qualified GHC.Utils.Logger as Logger import GHC.Utils.Outputable (ppr) import GHC.Types.Unique.DSM @@ -186,6 +190,59 @@ Given a `CmmGraph`: location. See `labelsToSourcesSansTNTC` for the implementation of this algorithm. + +Note [Prefer current-module source ticks for return frames] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A return frame's source location is taken from the `SourceNote`s of the block +that *ends* in the frame's call (see Note [Stacktraces from Info Table Provenance +Entries...] above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a +block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`, +`threadDelay`, ...) and the *nearest* note — the one historically chosen — is +often a library note rather than the user's code. The resulting IPE entry then +points at the library (its file and label; see `toCgIPE` in +GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a +backtrace of a thread blocked in such a primop shows no user frames. + +For a concrete example, compile (at -O1) + + -- Scan.hs + f3 :: IO () + f3 = threadDelay 1000000 >> putStrLn "done" + +The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a +block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick +for `f3` sits only in the proc's entry block: + + entry: -- the proc's entry block + //tick src<.../Base.hs:2305:5-18> + //tick src<Scan.hs:13:1-43> -- the enclosing `f3` span + //tick src<.../Conc/IO.hs:(223,1)-(235,10)> + ... + delayBlk: -- no Scan.hs note here: + //tick src<.../Conc/IO.hs:232:5-13> + //tick src<.../Base.hs:2268:1-9> + //tick src<.../Conc/IO.hs:(232,25)-(235,10)> -- nearest note + call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8; + +Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`, +i.e. an internal of `threadDelay`, rather than `f3`. + +To fix this we attribute a return frame's source location in the following +preference order: + + 1. the nearest tick in the frame's block whose file is that of the module + being compiled - the precise user call site. (When the user makes a + blocking call directly, e.g. `f v = takeMVar v`, such a note is present in + the call's block and this rule suffices; the `delayBlk` above has none.) + 2. failing that, the proc's *enclosing* current-module note (the outermost + current-module `SourceNote` in the proc, i.e. its function's own span). + For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to + `f3` rather than to `threadDelay`'s internals. + 3. failing that, the nearest note of any module (the historical behaviour). + +This mirrors the same-file preference the DWARF path uses in +`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses +for closures. -} generateCgIPEStub @@ -257,11 +314,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW -- performance suffered considerably as a result (see #23103). lookupEstimatedTicks :: HscEnv + -> ModLocation -- ^ location of the module being compiled, for IPE provenance -> Map CmmInfoTable (Maybe IpeSourceLocation) -> IPEStats -> CmmGroupSRTs -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) -lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = +lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts = -- Pass 2: Create an entry in the IPE map for every info table listed in -- this CmmGroupSRTs. If the info table is a stack info table and -- -finfo-table-map-with-stack is enabled, look up its estimated source @@ -276,6 +334,11 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = dflags = hsc_dflags hsc_env platform = targetPlatform dflags + -- Source file of the module being compiled, used to prefer current-module + -- source ticks for return frames. See Note [Prefer current-module source + -- ticks for return frames]. + mb_src_file = mkFastString <$> ml_hs_file mod_location + -- Pass 1: Map every label meeting the conditions described in Note -- [Stacktraces from Info Table Provenance Entries (IPE based stack -- unwinding)] to the estimated source location (also as described in the @@ -286,9 +349,9 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = labelsToSources :: Map CLabel IpeSourceLocation labelsToSources = if platformTablesNextToCode platform then - foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts else - foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) @@ -331,15 +394,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesWithTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation go acc block = - case (,) <$> returnFrameLabel <*> lastTickInBlock of + case (,) <$> returnFrameLabel <*> bestTickInBlock of Just (clabel, src_loc) -> Map.insert clabel src_loc acc Nothing -> acc where @@ -351,36 +415,80 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = (CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l _ -> Nothing - lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock) + -- All SourceNotes in the block, in block order. + -- See Note [Prefer current-module source ticks for return frames]. + bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock) + + -- Enclosing current-module note for the whole proc (its function's own + -- span), used when a return frame's own block has no current-module tick. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) +labelsToSourcesWithTNTC _ acc _ = acc - maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation - maybeTick _ s@(Just _) = s - maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name) - maybeTick _ _ = Nothing -labelsToSourcesWithTNTC acc _ = acc +-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the +-- source-note-bearing nodes of its block (in block order). +-- +-- See Note [Prefer current-module source ticks for return frames]. +preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation +preferThisFile mb_src_file procFallback nodes = + nearest fromThisFile <|> procFallback <|> nearest sourceNotes + where + sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ] + fromThisFile = case mb_src_file of + Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes + Nothing -> [] + nearest = listToMaybe . reverse + +-- | The outermost 'SourceNote' from the module being compiled across a proc's +-- blocks (in 'toBlockList' order, so the entry block's note — the function's own +-- span — comes first). Used as a fallback so inlined cross-module code is still +-- labelled with the enclosing user function. 'Nothing' when the proc has no +-- current-module note (e.g. when compiling the library itself). +enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation +enclosingThisFileTick mb_src_file blocks = + listToMaybe + [ (span, name) + | b <- blocks + , let (_, mid, _) = blockSplit b + , CmmTick (SourceNote span name) <- blockToList mid + , Just (srcSpanFile span) == mb_src_file ] -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesSansTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where + -- See 'enclosingThisFileTick'. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) + go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation - go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock) + go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock) where (_, middleBlock, _) = blockSplit block + -- We track the nearest preceding SourceNote from the module being + -- compiled and the nearest of any module, and prefer the former (then + -- the proc's enclosing current-module note) when attributing a return + -- frame. See 'preferThisFile' and + -- Note [Prefer current-module source ticks for return frames]. collectLabels - :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) + :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) -> CmmNode O O - -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) - collectLabels (!acc, lastTick) b = - case (b, lastTick) of - (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) -> - (Map.insert l src_loc acc, Nothing) - (CmmTick (SourceNote span name), _) -> - (acc, Just (span, name)) - _ -> (acc, lastTick) -labelsToSourcesSansTNTC acc _ = acc + -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) + collectLabels (!acc, st@(lastThis, lastAny)) b = + case b of + CmmStore _ (CmmLit (CmmLabel l)) _ -> + case lastThis <|> procFallback <|> lastAny of + Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing)) + Nothing -> (acc, st) + CmmTick (SourceNote span name) -> + let tick = (span, name) + lastThis' + | Just (srcSpanFile span) == mb_src_file = Just tick + | otherwise = lastThis + in (acc, (lastThis', Just tick)) + _ -> (acc, st) +labelsToSourcesSansTNTC _ acc _ = acc ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do _ -> do cmms <- {-# SCC "StgToCmm" #-} - doCodeGen hsc_env this_mod denv tycons + doCodeGen hsc_env this_mod mod_loc denv tycons cost_centre_info stg_binds @@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly (5-10%). -} -doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] +doCodeGen :: HscEnv -> Module + -> ModLocation -- ^ location of the module being compiled, used to + -- prefer current-module IPE source locations + -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> IO (CgStream CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -doCodeGen hsc_env this_mod denv tycons +doCodeGen hsc_env this_mod mod_location denv tycons cost_centre_info stg_binds_w_fvs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons -- Positions] in GHC.Stg.Debug. (ipes', stats') <- if (gopt Opt_InfoTableMap dflags) then - liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts + liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts else return (ipes, stats) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab46ad977c7ce6090523033597de082… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab46ad977c7ce6090523033597de082… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ipe-return-prefer-current-mod] compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 19 Jun '26

19 Jun '26

Ben Gamari pushed to branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC Commits: 33e82215 by Ben Gamari at 2026-06-19T17:46:43-04:00 compiler/ipe: Prefer source ticks in current module for return frames Previously we would simply attribute return frames to the nearest enclosing tick in the calling frame. However, this will very frequently produce unhelpful results (e.g. pointing to `(>>)` rather than the calling function). - - - - - 2 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main/Compile.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -1,7 +1,9 @@ module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where +import Control.Applicative ((<|>)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Maybe (listToMaybe) import Data.Semigroup ((<>)) import GHC.Cmm import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel) @@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList) import GHC.Cmm.Dataflow.Label import GHC.Cmm.Info.Build (emptySRT) import GHC.Cmm.Pipeline (cmmPipeline) +import GHC.Data.FastString (FastString, mkFastString) import GHC.Data.Stream (liftIO, liftEff) import qualified GHC.Data.Stream as Stream import GHC.Driver.Env (hsc_dflags, hsc_logger) @@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.CgUtils (CgStream) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) +import GHC.Types.SrcLoc (srcSpanFile) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module, moduleName) -import GHC.Unit.Module (moduleNameString) +import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file) import qualified GHC.Utils.Logger as Logger import GHC.Utils.Outputable (ppr) import GHC.Types.Unique.DSM @@ -186,6 +190,60 @@ Given a `CmmGraph`: location. See `labelsToSourcesSansTNTC` for the implementation of this algorithm. + +Note [Prefer current-module source ticks for return frames] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A block may carry several nested `SourceNote`s before its terminating call. +For example, when `>>`/`>>=` (and their continuations) are inlined into a user +`do`-block at `-O`, the case continuation of a blocking primop like `takeMVar#` +is wrapped in notes for both the combinator's definition (e.g. +`GHC.Internal.Base.thenIO`, `Base.hs`) and the user's call site (the `do` +statement). Naively taking the *nearest* note attributes the return frame to the +library combinator, so IPE/`-finfo-table-map` backtraces of a thread blocked in +such a primop show no user frames at all. + +Concretely, when compiling (at -O1) + + -- Main.hs + main = do { v <- newEmptyMVar; takeMVar v; putStrLn "world" } + +the proc for `main` begins with `main`'s own span and reaches `takeMVar#` +in a block carrying only the inlined `>>` combinator's ticks, while the next +tick of `main` itself lands in the *continuation* block: + + cEntry: + //tick src<Main.hs:(2,1)-(2,58)> -- (Tick 2) the enclosing `main` span + ... newEmptyMVar# etc. ... + cBlk: + //tick src<.../Base.hs:2336:37> -- only library ticks in this block: + //tick src<.../Base.hs:2336:67-71> -- the inlined `>>` (`thenIO`) + call stg_takeMVar#(R1) returns to cCont, args: 8, res: 8, upd: 8; + cCont: -- the takeMVar continuation body + //tick src<.../Base.hs:2336:60-71> + //tick src<Main.hs:2:34-43> -- (Tick 1) the user tick, in a + -- *sibling* block + +A return frame is attributed to the ticks of the block that *ends* in its call +(see `labelsToSourcesWithTNTC`). So `cCont` is sourced from `cBlk`, which has no +`Main.hs` tick at all. This is unhelpful to the user. + +To fix this we attribute a return frame's source location in the following +preference order: + + 1. the nearest tick in frame's block whose file is that of the module being + compiled — the precise user call site. `cBlk` has none. + 2. failing that, the proc's *enclosing* current-module note (its function's own + span, i.e. the outermost user `SourceNote` in the proc) — here + `src<Main.hs:(2,1)-(2,58)>`, named `main`. Without this, `cCont` would + take the nearest note `Base.hs:2336:67-71` (named `thenIO`) and, due to + rule (3) below, attribute it to the module being compiled. This would result + in a reference to `Main.thenIO`, a binding which does not exist. + does not exist. In the example above, (T2) labels it `Main.main` instead. + 3. failing that, the nearest note of any module. + +This mirrors the same-file preference the DWARF path uses in +`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses for +closures. -} generateCgIPEStub @@ -257,11 +315,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW -- performance suffered considerably as a result (see #23103). lookupEstimatedTicks :: HscEnv + -> ModLocation -- ^ location of the module being compiled, for IPE provenance -> Map CmmInfoTable (Maybe IpeSourceLocation) -> IPEStats -> CmmGroupSRTs -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) -lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = +lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts = -- Pass 2: Create an entry in the IPE map for every info table listed in -- this CmmGroupSRTs. If the info table is a stack info table and -- -finfo-table-map-with-stack is enabled, look up its estimated source @@ -276,6 +335,11 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = dflags = hsc_dflags hsc_env platform = targetPlatform dflags + -- Source file of the module being compiled, used to prefer current-module + -- source ticks for return frames. See Note [Prefer current-module source + -- ticks for return frames]. + mb_src_file = mkFastString <$> ml_hs_file mod_location + -- Pass 1: Map every label meeting the conditions described in Note -- [Stacktraces from Info Table Provenance Entries (IPE based stack -- unwinding)] to the estimated source location (also as described in the @@ -286,9 +350,9 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = labelsToSources :: Map CLabel IpeSourceLocation labelsToSources = if platformTablesNextToCode platform then - foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts else - foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts + foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) @@ -331,15 +395,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts = -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesWithTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation go acc block = - case (,) <$> returnFrameLabel <*> lastTickInBlock of + case (,) <$> returnFrameLabel <*> bestTickInBlock of Just (clabel, src_loc) -> Map.insert clabel src_loc acc Nothing -> acc where @@ -351,36 +416,84 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) = (CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l _ -> Nothing - lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock) - - maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation - maybeTick _ s@(Just _) = s - maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name) - maybeTick _ _ = Nothing -labelsToSourcesWithTNTC acc _ = acc + -- All SourceNotes in the block, in block order (so the last is the one + -- nearest the terminating call). Prefer a note from the module being + -- compiled, so that e.g. continuations of inlined library combinators + -- (>>, >>=) point at the user's call site rather than the combinator's + -- definition. See Note [Prefer current-module source ticks for return frames]. + -- This mirrors GHC.Cmm.DebugBlock.bestSrcTick. + bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock) + + -- Enclosing current-module note for the whole proc (its function's own + -- span), used when a return frame's own block has no current-module tick. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) +labelsToSourcesWithTNTC _ acc _ = acc + +-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the +-- source-note-bearing nodes of its block (in block order). +-- +-- See Note [Prefer current-module source ticks for return frames]. +preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation +preferThisFile mb_src_file procFallback nodes = + nearest fromThisFile <|> procFallback <|> nearest sourceNotes + where + sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ] + fromThisFile = case mb_src_file of + Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes + Nothing -> [] + nearest = listToMaybe . reverse + +-- | The outermost 'SourceNote' from the module being compiled across a proc's +-- blocks (in 'toBlockList' order, so the entry block's note — the function's own +-- span — comes first). Used as a fallback so inlined cross-module code is still +-- labelled with the enclosing user function. 'Nothing' when the proc has no +-- current-module note (e.g. when compiling the library itself). +enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation +enclosingThisFileTick mb_src_file blocks = + listToMaybe + [ (span, name) + | b <- blocks + , let (_, mid, _) = blockSplit b + , CmmTick (SourceNote span name) <- blockToList mid + , Just (srcSpanFile span) == mb_src_file ] -- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] labelsToSourcesSansTNTC - :: Map CLabel IpeSourceLocation + :: Maybe FastString -- ^ source file of the module being compiled + -> Map CLabel IpeSourceLocation -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Map CLabel IpeSourceLocation -labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) = +labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) = foldl' go acc (toBlockList cmm_graph) where + -- See 'enclosingThisFileTick'. + procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph) + go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation - go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock) + go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock) where (_, middleBlock, _) = blockSplit block + -- We track the nearest preceding SourceNote from the module being + -- compiled and the nearest of any module, and prefer the former (then + -- the proc's enclosing current-module note) when attributing a return + -- frame. See 'preferThisFile' and + -- Note [Prefer current-module source ticks for return frames]. collectLabels - :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) + :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) -> CmmNode O O - -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation) - collectLabels (!acc, lastTick) b = - case (b, lastTick) of - (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) -> - (Map.insert l src_loc acc, Nothing) - (CmmTick (SourceNote span name), _) -> - (acc, Just (span, name)) - _ -> (acc, lastTick) -labelsToSourcesSansTNTC acc _ = acc + -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation)) + collectLabels (!acc, st@(lastThis, lastAny)) b = + case b of + CmmStore _ (CmmLit (CmmLabel l)) _ -> + case lastThis <|> procFallback <|> lastAny of + Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing)) + Nothing -> (acc, st) + CmmTick (SourceNote span name) -> + let tick = (span, name) + lastThis' + | Just (srcSpanFile span) == mb_src_file = Just tick + | otherwise = lastThis + in (acc, (lastThis', Just tick)) + _ -> (acc, st) +labelsToSourcesSansTNTC _ acc _ = acc ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do _ -> do cmms <- {-# SCC "StgToCmm" #-} - doCodeGen hsc_env this_mod denv tycons + doCodeGen hsc_env this_mod mod_loc denv tycons cost_centre_info stg_binds @@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly (5-10%). -} -doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] +doCodeGen :: HscEnv -> Module + -> ModLocation -- ^ location of the module being compiled, used to + -- prefer current-module IPE source locations + -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> IO (CgStream CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -doCodeGen hsc_env this_mod denv tycons +doCodeGen hsc_env this_mod mod_location denv tycons cost_centre_info stg_binds_w_fvs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons -- Positions] in GHC.Stg.Debug. (ipes', stats') <- if (gopt Opt_InfoTableMap dflags) then - liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts + liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts else return (ipes, stats) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33e8221517c3049a3bf93bad08b31da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33e8221517c3049a3bf93bad08b31da… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/ipe-return-prefer-current-mod
by Ben Gamari (＠bgamari) 19 Jun '26

19 Jun '26

Ben Gamari pushed new branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-return-prefer-current-mod You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/stm-mvar-deadlock-backtrace] 5 commits: testsuite: Add LoopBacktrace test
by Ben Gamari (＠bgamari) 19 Jun '26

19 Jun '26

Ben Gamari pushed to branch wip/stm-mvar-deadlock-backtrace at Glasgow Haskell Compiler / GHC Commits: 0e661958 by Ben Gamari at 2026-06-19T17:16:44-04:00 testsuite: Add LoopBacktrace test - - - - - 030ac4b4 by Ben Gamari at 2026-06-19T17:16:44-04:00 Throw nontermination exceptions via `throw` This ensures that the exception that results gets the usual backtrace annotations. - - - - - 0d15e5c0 by Ben Gamari at 2026-06-19T17:16:44-04:00 ghc-heap: Decode OrigThunkInfo frames - - - - - f6f6314a by Ben Gamari at 2026-06-19T17:17:22-04:00 compiler: Report backtraces in MVar and STM dealocks Apply the same treatment previously given to Nontermination exceptions to MVar and STM deadlock exceptions, using `throw` instead of ad-hoc throwing with `throwToSingleThread` to ensure that the usual backtrace machinery is involved. - - - - - cba8d183 by Ben Gamari at 2026-06-19T17:17:22-04:00 testsuite: Add tests for deadlock backtraces - - - - - 22 changed files: - libraries/base/src/Control/Exception/Base.hs - libraries/base/src/GHC/IO/Exception.hs - libraries/ghc-internal/cbits/Stack.cmm - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - rts/Prelude.h - rts/RaiseAsync.c - rts/RaiseAsync.h - rts/RtsStartup.c - rts/Schedule.c - rts/include/rts/RtsToHsIface.h - + testsuite/tests/rts/LoopBacktrace.hs - + testsuite/tests/rts/LoopBacktrace.stderr - + testsuite/tests/rts/LoopBacktrace.stdout - + testsuite/tests/rts/MVarDeadlockBacktrace.hs - + testsuite/tests/rts/MVarDeadlockBacktrace.stderr - + testsuite/tests/rts/STMDeadlockBacktrace.hs - + testsuite/tests/rts/STMDeadlockBacktrace.stderr - testsuite/tests/rts/all.T Changes: ===================================== libraries/base/src/Control/Exception/Base.hs ===================================== @@ -85,7 +85,6 @@ module Control.Exception.Base patError, noMethodBindingError, typeError, - nonTermination, nestedAtomically, noMatchingContinuationPrompt ) where ===================================== libraries/base/src/GHC/IO/Exception.hs ===================================== @@ -19,8 +19,8 @@ -- module GHC.IO.Exception ( - BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar, - BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM, + BlockedIndefinitelyOnMVar(..), + BlockedIndefinitelyOnSTM(..), Deadlock(..), AllocationLimitExceeded(..), allocationLimitExceeded, AssertionFailed(..), ===================================== libraries/ghc-internal/cbits/Stack.cmm ===================================== @@ -3,6 +3,10 @@ #include "Cmm.h" +#if !defined(UnregisterisedCompiler) +import CLOSURE stg_orig_thunk_info_frame_info; +#endif + // StgStack_marking was not available in the Stage0 compiler at the time of // writing. Because, it has been added to derivedConstants when Stack.cmm was // developed. @@ -168,6 +172,18 @@ getStackInfoTableAddrzh(P_ stack) { return (info); } +// (StgInfoTable*) getOrigThunkInfoPtrzh(StgStack* stack, StgWord offsetWords) +getOrigThunkInfoPtrzh(P_ stack, W_ offsetWords) { + P_ p; + p = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + if (%INFO_PTR(UNTAG(p)) == stg_orig_thunk_info_frame_info) { + return (StgOrigThunkInfoFrame_info_ptr(UNTAG(p))); + } else { + return (NULL); + } +} + // (StgClosure*) getStackClosurezh(StgStack* stack, StgWord offsetWords) getStackClosurezh(P_ stack, W_ offsetWords) { P_ ptr; ===================================== libraries/ghc-internal/include/RtsIfaceSymbols.h ===================================== @@ -15,12 +15,12 @@ CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure) CLOSURE(GHCziInternalziIOziException, stackOverflow_closure) CLOSURE(GHCziInternalziIOziException, heapOverflow_closure) CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure) -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure) -CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure) +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVarError_closure) +CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTMError_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure) CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure) -CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure) +CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure) #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 ( impossibleError, impossibleConstraintError, nonExhaustiveGuardsError, patError, noMethodBindingError, typeError, - nonTermination, nestedAtomically, noMatchingContinuationPrompt, + nonTerminationError, nestedAtomically, noMatchingContinuationPrompt, ) where import GHC.Internal.Base ( @@ -448,8 +448,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) -- GHC's RTS calls this -nonTermination :: SomeException -nonTermination = toException NonTermination +nonTerminationError :: IO () +nonTerminationError = throwIO NonTermination + -- GHC's RTS calls this nestedAtomically :: SomeException ===================================== libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs ===================================== @@ -568,6 +568,17 @@ data GenStackFrame b = , stack_payload :: ![GenStackField b] } + -- | An @stg_orig_thunk_info_frame@ pushed by @-forig-thunk-info@. It records + -- the original info table of the thunk being updated (in 'orig_info_tbl'), + -- which is otherwise lost when the thunk is blackholed. + -- See @Note [Original thunk info table frames]@ in "GHC.StgToCmm.Bind". + | OrigThunkInfo + { info_tbl :: !StgInfoTable + -- ^ the frame's own (RTS) info table + , orig_info_tbl :: !(Ptr StgInfoTable) + -- ^ the original info table of the thunk being updated + } + | RetFun { info_tbl :: !StgInfoTable , retFunSize :: !Word ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs ===================================== @@ -24,8 +24,8 @@ ----------------------------------------------------------------------------- module GHC.Internal.IO.Exception ( - BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar, - BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM, + BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVarError, + BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTMError, Deadlock(..), AllocationLimitExceeded(..), allocationLimitExceeded, AssertionFailed(..), @@ -84,8 +84,8 @@ instance Exception BlockedIndefinitelyOnMVar instance Show BlockedIndefinitelyOnMVar where showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" -blockedIndefinitelyOnMVar :: SomeException -- for the RTS -blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar +blockedIndefinitelyOnMVarError :: IO () -- for the RTS +blockedIndefinitelyOnMVarError = throwIO BlockedIndefinitelyOnMVar ----- @@ -100,8 +100,8 @@ instance Exception BlockedIndefinitelyOnSTM instance Show BlockedIndefinitelyOnSTM where showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" -blockedIndefinitelyOnSTM :: SomeException -- for the RTS -blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM +blockedIndefinitelyOnSTMError :: IO () -- for the RTS +blockedIndefinitelyOnSTMError = throwIO BlockedIndefinitelyOnSTM ----- ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -192,6 +192,16 @@ foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# - foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# +foreign import prim "getOrigThunkInfoPtrzh" getOrigThunkInfoPtr# :: StackSnapshot# -> Word# -> Addr# + +-- | @'Just' itbl@ if the frame at the given offset is an +-- @stg_orig_thunk_info_frame@ (where @itbl@ is the recorded original thunk info +-- table), otherwise 'Nothing'. See @Note [Decoding orig_thunk_info frames]@. +origThunkInfoFrame :: StackSnapshot# -> WordOffset -> Maybe (Ptr StgInfoTable) +origThunkInfoFrame stackSnapshot# index = + let p = Ptr (getOrigThunkInfoPtr# stackSnapshot# (wordOffsetToWord# index)) + in if p == nullPtr then Nothing else Just p + -- | Get the 'StgInfoTable' of the stack frame. -- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any. getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv) @@ -380,6 +390,15 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi bco = bco', bcoArgs = bcoArgs' } + RET_SMALL + | Just orig_itbl <- origThunkInfoFrame stackSnapshot# index -> do + orig_info_prov <- lookupIPE (castPtr orig_itbl) + finaliseStackFrame + OrigThunkInfo + { info_tbl = info, + orig_info_tbl = orig_itbl + } + orig_info_prov RET_SMALL -> let payload' = decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload in ===================================== rts/Prelude.h ===================================== @@ -53,12 +53,12 @@ extern StgClosure ZCMain_main_closure; #define stackOverflow_closure ghc_hs_iface->stackOverflow_closure #define heapOverflow_closure ghc_hs_iface->heapOverflow_closure #define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure -#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure -#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure +#define blockedIndefinitelyOnMVarError_closure ghc_hs_iface->blockedIndefinitelyOnMVarError_closure +#define blockedIndefinitelyOnSTMError_closure ghc_hs_iface->blockedIndefinitelyOnSTMError_closure #define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure #define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure #define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure -#define nonTermination_closure ghc_hs_iface->nonTermination_closure +#define nonTerminationError_closure ghc_hs_iface->nonTerminationError_closure #define nestedAtomically_closure ghc_hs_iface->nestedAtomically_closure #define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure #define underflowException_closure ghc_hs_iface->underflowException_closure ===================================== rts/RaiseAsync.c ===================================== @@ -87,6 +87,55 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here) throwToSingleThreaded__ (cap, tso, NULL, false, stop_here); } +/* ----------------------------------------------------------------------------- + scheduleRaiseViaIO + + Schedule `tso` to raise an exception by running `io_action`, an IO () that + performs `throwIO`. Unlike throwToSingleThreaded (which injects an exception + *value* via raiseAsync), the exception is raised by throwIO *within* the + thread, so it acquires a backtrace of the thread's stack. This is used by + resurrectThreads to deliver the "blocked indefinitely" exceptions + (BlockedIndefinitelyOnMVar, BlockedIndefinitelyOnSTM, NonTermination). + + We push a "run this IO action" frame on top of the thread's existing + (suspended) stack and make it runnable; when the thread runs, throwIO raises + the exception and its own stack unwinding handles any CATCH_FRAME / + ATOMICALLY_FRAME (e.g. aborting a blocked STM transaction). + + removeFromQueues takes care of unlinking the thread from any blocking queue + (notably the MVar blocked queue) and appends it to the run queue. As with + throwToSingleThreaded, the caller must own the TSO (e.g. hold all + capabilities during GC); in particular this relies on the thread not being + scheduled between removeFromQueues' enqueue and our stack push. + -------------------------------------------------------------------------- */ + +void +scheduleRaiseViaIO (Capability *cap, StgTSO *tso, StgClosure *io_action) +{ + // Thread already dead? + if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) { + return; + } + + // Unlink from any blocking queues; sets why_blocked = NotBlocked and + // appends the thread to the run queue. + removeFromQueues(cap, tso); + + StgStack *stack = tso->stackobj; + + // We are about to mutate the stack, so dirty it for the GC write barrier + // (resurrectThreads runs right after GC). + dirty_TSO(cap, tso); + dirty_STACK(cap, stack); + + // Push a frame that enters `io_action` and applies the resulting IO action + // to the void (RealWorld) argument: [stg_enter_info, io_action, stg_ap_v_info] + stack->sp -= 3; + stack->sp[0] = (W_)&stg_enter_info; + stack->sp[1] = (W_)io_action; + stack->sp[2] = (W_)&stg_ap_v_info; +} + /* ----------------------------------------------------------------------------- throwToSelf ===================================== rts/RaiseAsync.h ===================================== @@ -38,6 +38,10 @@ void suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here); +void scheduleRaiseViaIO (Capability *cap, + StgTSO *tso, + StgClosure *io_action); + MessageThrowTo *throwTo (Capability *cap, // the Capability we hold StgTSO *source, StgTSO *target, ===================================== rts/RtsStartup.c ===================================== @@ -192,9 +192,9 @@ static void initBuiltinGcRoots(void) getStablePtr((StgPtr)stackOverflow_closure); getStablePtr((StgPtr)heapOverflow_closure); getStablePtr((StgPtr)unpackCString_closure); - getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure); - getStablePtr((StgPtr)nonTermination_closure); - getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnMVarError_closure); + getStablePtr((StgPtr)nonTerminationError_closure); + getStablePtr((StgPtr)blockedIndefinitelyOnSTMError_closure); getStablePtr((StgPtr)allocationLimitExceeded_closure); getStablePtr((StgPtr)cannotCompactFunction_closure); getStablePtr((StgPtr)cannotCompactPinned_closure); ===================================== rts/Schedule.c ===================================== @@ -3309,16 +3309,16 @@ resurrectThreads (StgTSO *threads) case BlockedOnMVar: case BlockedOnMVarRead: /* Called by GC - sched_mutex lock is currently held. */ - throwToSingleThreaded(cap, tso, - (StgClosure *)blockedIndefinitelyOnMVar_closure); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)blockedIndefinitelyOnMVarError_closure); break; case BlockedOnBlackHole: - throwToSingleThreaded(cap, tso, - (StgClosure *)nonTermination_closure); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)nonTerminationError_closure); break; case BlockedOnSTM: - throwToSingleThreaded(cap, tso, - (StgClosure *)blockedIndefinitelyOnSTM_closure); + scheduleRaiseViaIO(cap, tso, + (StgClosure *)blockedIndefinitelyOnSTMError_closure); break; case NotBlocked: /* This might happen if the thread was blocked on a black hole ===================================== rts/include/rts/RtsToHsIface.h ===================================== @@ -20,12 +20,12 @@ typedef struct { StgClosure *stackOverflow_closure; // GHC.Internal.IO.Exception.stackOverflow_closure StgClosure *heapOverflow_closure; // GHC.Internal.IO.Exception.heapOverflow_closure StgClosure *allocationLimitExceeded_closure; // GHC.Internal.IO.Exception.allocationLimitExceeded_closure - StgClosure *blockedIndefinitelyOnMVar_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure - StgClosure *blockedIndefinitelyOnSTM_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure + StgClosure *blockedIndefinitelyOnMVarError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVarError_closure + StgClosure *blockedIndefinitelyOnSTMError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTMError_closure StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure - StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure + StgClosure *nonTerminationError_closure; // GHC.Internal.Control.Exception.Base.nonTerminationError_closure StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure ===================================== testsuite/tests/rts/LoopBacktrace.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-} + +import GHC.Exception.Backtrace.Experimental + +x :: Integer +x = x + 1 + +testing :: IO () +testing = do + putStrLn "hello" + print x + putStrLn "world" + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + testing ===================================== testsuite/tests/rts/LoopBacktrace.stderr ===================================== @@ -0,0 +1,21 @@ +LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination: + +<<loop>> + +IPE backtrace: + GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25)) + GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56) + GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53)) + GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36) + Cmm$rts/HeapStackCheck.cmm. (:) + GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52)) + Cmm$rts/Updates.cmm. (:) + Main.x (LoopBacktrace.hs:6:1-9) + GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21) + GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37) + GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72) + Cmm$rts/Exception.cmm. (:) + Cmm$rts/StgStartup.cmm. (:) +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base + ===================================== testsuite/tests/rts/LoopBacktrace.stdout ===================================== @@ -0,0 +1 @@ +hello ===================================== testsuite/tests/rts/MVarDeadlockBacktrace.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -finfo-table-map #-} + +-- | Check that a @BlockedIndefinitelyOnMVar@ deadlock exception carries a +-- backtrace mentioning the blocking site in this module. +import Control.Concurrent.MVar +import GHC.Exception.Backtrace.Experimental + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + mv <- newEmptyMVar :: IO (MVar ()) + x <- takeMVar mv + print x ===================================== testsuite/tests/rts/MVarDeadlockBacktrace.stderr ===================================== @@ -0,0 +1,2 @@ +MVarDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar: + Main.main (MVarDeadlockBacktrace.hs:16:3-36) ===================================== testsuite/tests/rts/STMDeadlockBacktrace.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -finfo-table-map #-} + +-- | Check that a @BlockedIndefinitelyOnSTM@ deadlock exception carries a +-- backtrace mentioning the blocking site in this module. +import GHC.Conc (atomically, retry) +import GHC.Exception.Backtrace.Experimental + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + x <- atomically retry :: IO () + print x ===================================== testsuite/tests/rts/STMDeadlockBacktrace.stderr ===================================== @@ -0,0 +1,2 @@ +STMDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM: + Main.main (STMDeadlockBacktrace.hs:16:3-32) ===================================== testsuite/tests/rts/all.T ===================================== @@ -687,3 +687,11 @@ test('ClosureTable', ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include']) test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, ['']) + +test('LoopBacktrace', [exit_code(1)], compile_and_run, ['']) + +deadlock_backtrace_norm = grep_errmsg(r'(Uncaught exception|Main\.)') +test('MVarDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm], + compile_and_run, ['-O']) +test('STMDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm], + compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa8026fe0480e1539a21b2ae89db40… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa8026fe0480e1539a21b2ae89db40… You're receiving this email because of your account on gitlab.haskell.org.

1 0