October 2025 - ghc-commits

[Git][ghc/ghc] Pushed new branch wip/26507
by Matthew Pickering (＠mpickering) 20 Oct '25

20 Oct '25

Matthew Pickering pushed new branch wip/26507 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/26507 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Move code-gen aux symbols from ghc-internal to rts
by Marge Bot (＠marge-bot) 20 Oct '25

20 Oct '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ba3e5bdd by Rodrigo Mesquita at 2025-10-18T16:57:18-04:00 Move code-gen aux symbols from ghc-internal to rts These symbols were all previously defined in ghc-internal and made the dependency structure awkward, where the rts may refer to some of these symbols and had to work around that circular dependency the way described in #26166. Moreover, the code generator will produce code that uses these symbols! Therefore, they should be available in the rts: PRINCIPLE: If the code generator may produce code which uses this symbol, then it should be defined in the rts rather than, say, ghc-internal. That said, the main motivation is towards fixing #26166. Towards #26166. Pre-requisite of !14892 - - - - - f31de2a9 by Ben Gamari at 2025-10-18T16:57:18-04:00 rts: Avoid static symbol references to ghc-internal This resolves #26166, a bug due to new constraints placed by Apple's linker on undefined references. One source of such references in the RTS is the many symbols referenced in ghc-internal. To mitigate #26166, we make these references dynamic, as described in Note [RTS/ghc-internal interface]. Fixes #26166 Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com> Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - 43fdfddc by Ben Gamari at 2025-10-18T16:57:18-04:00 compiler: Rename isMathFun -> isLibcFun This set includes more than just math functions. - - - - - 4ed5138f by Ben Gamari at 2025-10-18T16:57:18-04:00 compiler: Add libc allocator functions to libc_funs Prototypes for these are now visible from `Prim.h`, resulting in multiple-declaration warnings in the unregisterised job. - - - - - 9a0a076b by Ben Gamari at 2025-10-18T16:57:18-04:00 rts: Minimize header dependencies of Prim.h Otherwise we will end up with redundant and incompatible declarations resulting in warnings during the unregisterised build. - - - - - 26b8a414 by Diego Antonio Rosario Palomino at 2025-10-18T16:58:10-04:00 Cmm Parser: Fix incorrect example in comment The Parser.y file contains a comment with an incorrect example of textual Cmm (used in .cmm files). This commit updates the comment to ensure it reflects valid textual Cmm syntax. Fixes #26313 - - - - - d4a9d6d6 by ARATA Mizuki at 2025-10-19T18:43:47+09:00 Handle implications between x86 feature flags This includes: * Multiple -msse* options can be specified * -mavx implies -msse4.2 * -mavx2 implies -mavx * -mfma implies -mavx * -mavx512f implies -mavx2 and -mfma * -mavx512{cd,er,pf} imply -mavx512f Closes #24989 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 0d98f6fd by Cheng Shao at 2025-10-20T03:44:35-04:00 wasm: workaround WebKit bug in dyld This patch works around a WebKit bug and allows dyld to run on WebKit based platforms as well. See added note for detailed explanation. Co-authored-by: Codex <codex(a)openai.com> - - - - - 67 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/Linker/Dynamic.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - docs/users_guide/9.16.1-notes.rst - docs/users_guide/using.rst - hadrian/src/Settings/Packages.hs - + libraries/ghc-internal/cbits/RtsIface.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/include/RtsIfaceSymbols.h - rts/BuiltinClosures.c - rts/CloneStack.h - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/Prelude.h - rts/PrimOps.cmm - rts/RtsAPI.c - rts/RtsStartup.c - rts/RtsSymbols.c - + rts/RtsToHsIface.c - rts/StgStdThunks.cmm - rts/configure.ac - − rts/external-symbols.list.in - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/Stg.h - + rts/include/rts/RtsToHsIface.h - rts/include/rts/Types.h - rts/include/stg/Prim.h - rts/posix/Signals.c - libraries/ghc-internal/cbits/atomic.c → rts/prim/atomic.c - libraries/ghc-internal/cbits/bitrev.c → rts/prim/bitrev.c - libraries/ghc-internal/cbits/bswap.c → rts/prim/bswap.c - libraries/ghc-internal/cbits/clz.c → rts/prim/clz.c - libraries/ghc-internal/cbits/ctz.c → rts/prim/ctz.c - libraries/ghc-internal/cbits/int64x2minmax.c → rts/prim/int64x2minmax.c - libraries/ghc-internal/cbits/longlong.c → rts/prim/longlong.c - libraries/ghc-internal/cbits/mulIntMayOflo.c → rts/prim/mulIntMayOflo.c - libraries/ghc-internal/cbits/pdep.c → rts/prim/pdep.c - libraries/ghc-internal/cbits/pext.c → rts/prim/pext.c - libraries/ghc-internal/cbits/popcnt.c → rts/prim/popcnt.c - libraries/ghc-internal/cbits/vectorQuotRem.c → rts/prim/vectorQuotRem.c - libraries/ghc-internal/cbits/word2float.c → rts/prim/word2float.c - − rts/rts.buildinfo.in - rts/rts.cabal - rts/wasm/JSFFI.c - rts/wasm/scheduler.cmm - rts/win32/libHSghc-internal.def - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_gen_asm/mavx-should-enable-popcnt.asm - + testsuite/tests/codeGen/should_gen_asm/mavx-should-enable-popcnt.hs - + testsuite/tests/codeGen/should_gen_asm/msse-option-order.asm - + testsuite/tests/codeGen/should_gen_asm/msse-option-order.hs - utils/deriveConstants/Main.hs - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87846a202b9a423926d390ff200553… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87846a202b9a423926d390ff200553… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T20264] Simplify mkcoreAbsLams a bit
by Simon Peyton Jones (＠simonpj) 20 Oct '25

20 Oct '25

Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC Commits: f694f932 by Simon Peyton Jones at 2025-10-19T22:40:09+01:00 Simplify mkcoreAbsLams a bit ..Needs documentation - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -3133,8 +3133,8 @@ So: * When we make an AbsVars list, we close over the free vars of the unfoldings of any tyvars in it. So if `b{=Maybe a}` is in the list then so is `a` -* `mkCoreAbsLams` forms a lambda abstraction pushing the tyvar bindings - into the body: +* `mkCoreAbsLams` (more generally `mkPolyAbsLams`) forms a lambda abstraction pushing + the tyvar bindings into the body: mkCoreAbsLams [a, b=[a], x:b] body = \a. \(x:[a]). let @b = [a] in body @@ -3175,9 +3175,9 @@ mkPolyAbsLams (getter,setter) bndrs body = Lam (setter var1 bndr) (go unf_tvs binds' bndrs) | isId var, change_ty || change_unf - , let binds' | isDeadBinder var = binds - | otherwise = NonRec bndr (Var id2) : binds - = Lam (setter id2 bndr) (go unf_tvs binds' bndrs) +-- , let binds' | isDeadBinder var = binds +-- | otherwise = NonRec bndr (Var id2) : binds + = Lam (setter id2 bndr) (go unf_tvs binds bndrs) | otherwise = Lam bndr (go unf_tvs binds bndrs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f694f932f348e61c0cd6c1c65cec4ea… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f694f932f348e61c0cd6c1c65cec4ea… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/wasm-dyld-fix-webkit] wasm: workaround WebKit bug in dyld
by Cheng Shao (＠TerrorJack) 20 Oct '25

20 Oct '25

Cheng Shao pushed to branch wip/wasm-dyld-fix-webkit at Glasgow Haskell Compiler / GHC Commits: 7b420c6d by Cheng Shao at 2025-10-19T21:24:18+02:00 wasm: workaround WebKit bug in dyld This patch works around a WebKit bug and allows dyld to run on WebKit based platforms as well. See added note for detailed explanation. Co-authored-by: Codex <codex(a)openai.com> - - - - - 1 changed file: - utils/jsffi/dyld.mjs Changes: ===================================== utils/jsffi/dyld.mjs ===================================== @@ -670,7 +670,25 @@ class DyLD { // Wasm memory & table #memory = new WebAssembly.Memory({ initial: 1 }); + #table = new WebAssembly.Table({ element: "anyfunc", initial: 1 }); + // First free slot, might be invalid when it advances to #table.length + #tableFree = 1; + // See Note [The evil wasm table grower] + #tableGrowInstance = new WebAssembly.Instance( + new WebAssembly.Module( + new Uint8Array([ + 0, 97, 115, 109, 1, 0, 0, 0, 1, 6, 1, 96, 1, 127, 1, 127, 2, 35, 1, 3, + 101, 110, 118, 25, 95, 95, 105, 110, 100, 105, 114, 101, 99, 116, 95, + 102, 117, 110, 99, 116, 105, 111, 110, 95, 116, 97, 98, 108, 101, 1, + 112, 0, 0, 3, 2, 1, 0, 7, 31, 1, 27, 95, 95, 103, 104, 99, 95, 119, 97, + 115, 109, 95, 106, 115, 102, 102, 105, 95, 116, 97, 98, 108, 101, 95, + 103, 114, 111, 119, 0, 0, 10, 11, 1, 9, 0, 208, 112, 32, 0, 252, 15, 0, + 11, + ]) + ), + { env: { __indirect_function_table: this.#table } } + ); // __stack_pointer #sp = new WebAssembly.Global( @@ -715,6 +733,82 @@ class DyLD { // Global STG registers #regs = {}; + // Note [The evil wasm table grower] + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + // We need to grow the wasm table as we load shared libraries in + // wasm dyld. We used to directly call the table.grow() JS API, + // which works as expected in Firefox/Chrome, but unfortunately, + // WebKit's implementation of the table.grow() JS API is broken: + // https://bugs.webkit.org/show_bug.cgi?id=290681, which means that + // the wasm dyld simply does not work in WebKit-based browsers like + // Safari. + // + // Now, one simple workaround would be to avoid growing the table at + // all: just allocate a huge table upfront (current limitation + // agreed by all vendors is 10000000). To avoid unnecessary space + // waste on non-WebKit platforms, we could additionally check + // navigator.userAgent against some regexes and only allocate + // fixed-length table when there's no blink/gecko mention. But this + // is fragile and gross, and it's better to stick to a uniform code + // path for all browsers. + // + // Fortunately, it turns out the table.grow wasm instruction work as + // expected in WebKit! So we can invoke a wasm function that grows + // the table for us. But don't open a champagne yet, where would + // that wasm function come from? It can't be put into RTS, or even + // libc.so, because loading those libraries would require growing + // the table in the first place! Or perhaps, reserve a table upfront + // that's just large enough to load RTS and then we can access that + // function for subsequent table grows? But then we need to + // experiment for a reasonable initial size, and add a magic number + // here, which is also fragile and gross and not future-proof! + // + // So this special wasm function needs to live in a single wasm + // module, which is loaded before we load anything else. The full + // source code for this module is: + // + // (module + // (type (func (param i32) (result i32))) + // (import "env" "__indirect_function_table" (table 0 funcref)) + // (export "__ghc_wasm_jsffi_table_grow" (func 0)) + // (func (type 0) (param i32) (result i32) + // ref.null func + // local.get 0 + // table.grow 0 + // ) + // ) + // + // This module is 103 bytes so that we can inline its blob in dyld, + // and use the usually discouraged synchronous + // WebAssembly.Instance/WebAssembly.Module constructors to load it. + // On non-WebKit platforms, growing tables this way would introduce + // a bit of extra JS/Wasm interop overhead, which can be amplified + // as we used to call table.grow(1, foo) for every GOT.func item. + // Therefore, unless we're about to exceed the hard limit of table + // size, we now grow the table exponentially, and use bump + // allocation to calculate the table index to be returned. + // Exponential growth is only implemented to minimize the JS/Wasm + // interop overhead when calling __ghc_wasm_jsffi_table_grow; + // V8/SpiderMonkey/WebKit already do their own exponential growth of + // the table's backing buffer in their table growth logic. + // + // Invariants: n >= 0; when v is non-null, n === 1 + #tableGrow(n, v) { + const prev_free = this.#tableFree; + if (prev_free + n > this.#table.length) { + const min_delta = prev_free + n - this.#table.length; + const delta = Math.max(min_delta, this.#table.length); + this.#tableGrowInstance.exports.__ghc_wasm_jsffi_table_grow( + this.#table.length + delta <= 10000000 ? delta : min_delta + ); + } + if (v) { + this.#table.set(prev_free, v); + } + this.#tableFree += n; + return prev_free; + } + constructor({ args, rpc }) { this.#rpc = rpc; @@ -878,7 +972,7 @@ class DyLD { // __memory_base & __table_base, different for each .so let memory_base; - let table_base = this.#table.grow(tableSize); + let table_base = this.#tableGrow(tableSize); console.assert(tableP2Align === 0); // libc.so is always the first one to be ever loaded and has VIP @@ -982,7 +1076,7 @@ class DyLD { if (this.exportFuncs[name]) { this.#gotFunc[name] = new WebAssembly.Global( { value: "i32", mutable: true }, - this.#table.grow(1, this.exportFuncs[name]) + this.#tableGrow(1, this.exportFuncs[name]) ); continue; } @@ -1033,7 +1127,7 @@ class DyLD { if (this.#gotFunc[k]) { const got = this.#gotFunc[k]; if (got.value === DyLD.#poison) { - const idx = this.#table.grow(1, v); + const idx = this.#tableGrow(1, v); got.value = idx; } else { this.#table.set(got.value, v); @@ -1103,7 +1197,7 @@ class DyLD { // Not in GOT.func yet, create the entry on demand if (this.exportFuncs[sym]) { console.assert(!this.#gotFunc[sym]); - const addr = this.#table.grow(1, this.exportFuncs[sym]); + const addr = this.#tableGrow(1, this.exportFuncs[sym]); this.#gotFunc[sym] = new WebAssembly.Global( { value: "i32", mutable: true }, addr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b420c6dd78aa384fe4c23b2570354b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b420c6dd78aa384fe4c23b2570354b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/wasm-dyld-fix-webkit
by Cheng Shao (＠TerrorJack) 20 Oct '25

20 Oct '25

Cheng Shao pushed new branch wip/wasm-dyld-fix-webkit at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wasm-dyld-fix-webkit You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/supersven/hadrian-cleanup-flags
by Sven Tennie (＠supersven) 19 Oct '25

19 Oct '25

Sven Tennie pushed new branch wip/supersven/hadrian-cleanup-flags at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/hadrian-cleanup-fla… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/revert-backtrace-decoder] 2 commits: Revert "Implement `decode` in terms of `decodeStackWithIpe`"
by Hannes Siebenhandl (＠fendor) 19 Oct '25

19 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/revert-backtrace-decoder at Glasgow Haskell Compiler / GHC Commits: e7da8791 by fendor at 2025-10-19T10:27:43+02:00 Revert "Implement `decode` in terms of `decodeStackWithIpe`" This reverts commit bd80bb7013b1c2446557a56779c88e7ad1a06259. ------------------------- Metric Decrease: size_hello_artifact size_hello_artifact_gzip size_hello_unicode size_hello_unicode_gzip ------------------------- - - - - - 17cc9ffd by fendor at 2025-10-19T10:27:43+02:00 Add regression test for #26507 - - - - - 14 changed files: - libraries/base/src/GHC/Stack/CloneStack.hs - libraries/ghc-internal/cbits/Stack.cmm - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/jsbits/base.js - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/src/GHC/Stack/CloneStack.hs ===================================== @@ -17,4 +17,3 @@ module GHC.Stack.CloneStack ( ) where import GHC.Internal.Stack.CloneStack -import GHC.Internal.Stack.Decode ===================================== libraries/ghc-internal/cbits/Stack.cmm ===================================== @@ -146,14 +146,14 @@ isArgGenBigRetFunTypezh(P_ stack, W_ offsetWords) { return (type); } -// (StgInfoTable*, StgInfoTable*) getInfoTableAddrszh(StgStack* stack, StgWord offsetWords) -getInfoTableAddrszh(P_ stack, W_ offsetWords) { - P_ p, info_struct, info_ptr_ipe_key; +// (StgInfoTable*) getInfoTableAddrzh(StgStack* stack, StgWord offsetWords) +getInfoTableAddrzh(P_ stack, W_ offsetWords) { + P_ p, info; p = StgStack_sp(stack) + WDS(offsetWords); ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info_struct = %GET_STD_INFO(UNTAG(p)); - info_ptr_ipe_key = %INFO_PTR(UNTAG(p)); - return (info_struct, info_ptr_ipe_key); + info = %GET_STD_INFO(UNTAG(p)); + + return (info); } // (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack) ===================================== libraries/ghc-internal/cbits/Stack_c.c ===================================== @@ -30,7 +30,7 @@ StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) { const StgInfoTable *getItbl(StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); return get_itbl(closure); -} +}; StgWord getBitmapSize(StgClosure *c) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); ===================================== libraries/ghc-internal/jsbits/base.js ===================================== @@ -1245,21 +1245,9 @@ function h$mkdir(path, path_offset, mode) { // It is required by Google Closure Compiler to be at least defined if // somewhere it is used -var h$stg_cloneMyStackzh, - h$advanceStackFrameLocationzh, h$getStackFieldszh, h$getStackClosurezh, - h$getWordzh, h$getStackInfoTableAddrzh, h$getRetFunSmallBitmapzh, h$getRetFunLargeBitmapzh, - h$isArgGenBigRetFunTypezh, - h$getUnderflowFrameNextChunkzh, - h$getInfoTableAddrszh, - h$getLargeBitmapzh, h$getSmallBitmapzh, h$getBCOLargeBitmapzh +var h$stg_cloneMyStackzh, h$stg_decodeStackzh h$stg_cloneMyStackzh - = h$advanceStackFrameLocationzh - = h$getStackFieldszh = h$getStackClosurezh - = h$getWordzh, h$getStackInfoTableAddrzh = h$getRetFunSmallBitmapzh = h$getRetFunLargeBitmapzh - = h$isArgGenBigRetFunTypezh - = h$getUnderflowFrameNextChunkzh - = h$getInfoTableAddrszh - = h$getLargeBitmapzh = h$getSmallBitmapzh = h$getBCOLargeBitmapzh + = h$stg_decodeStackzh = function () { throw new Error('Stack Cloning Decoding: Not Implemented Yet') } ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs ===================================== @@ -11,12 +11,11 @@ import GHC.Internal.IORef import GHC.Internal.IO.Unsafe (unsafePerformIO) import GHC.Internal.Exception.Context import GHC.Internal.Ptr -import GHC.Internal.Data.Maybe (fromMaybe, mapMaybe) +import GHC.Internal.Data.Maybe (fromMaybe) import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack) import qualified GHC.Internal.Stack as HCS import qualified GHC.Internal.ExecutionStack.Internal as ExecStack import qualified GHC.Internal.Stack.CloneStack as CloneStack -import qualified GHC.Internal.Stack.Decode as CloneStack import qualified GHC.Internal.Stack.CCS as CCS -- | How to collect a backtrace when an exception is thrown. @@ -144,7 +143,7 @@ displayBacktraces bts = concat displayExec = unlines . map (indent 2 . flip ExecStack.showLocation "") . fromMaybe [] . ExecStack.stackFrames -- The unsafePerformIO here is safe as 'StackSnapshot' makes sure neither the stack frames nor -- references closures can be garbage collected. - displayIpe = unlines . mapMaybe (fmap (indent 2) . CloneStack.prettyStackFrameWithIpe) . unsafePerformIO . CloneStack.decodeStackWithIpe + displayIpe = unlines . map (indent 2 . CloneStack.prettyStackEntry) . unsafePerformIO . CloneStack.decode displayHsc = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack where prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs ===================================== @@ -15,20 +15,34 @@ -- @since base-4.17.0.0 module GHC.Internal.Stack.CloneStack ( StackSnapshot(..), + StackEntry(..), cloneMyStack, cloneThreadStack, + decode, + prettyStackEntry ) where import GHC.Internal.MVar +import GHC.Internal.Data.Maybe (catMaybes) import GHC.Internal.Base +import GHC.Internal.Foreign.Storable import GHC.Internal.Conc.Sync +import GHC.Internal.IO (unsafeInterleaveIO) +import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE, StgInfoTable) +import GHC.Internal.Num +import GHC.Internal.Real (div) import GHC.Internal.Stable +import GHC.Internal.Text.Show +import GHC.Internal.Ptr +import GHC.Internal.ClosureTypes -- | A frozen snapshot of the state of an execution stack. -- -- @since base-4.17.0.0 data StackSnapshot = StackSnapshot !StackSnapshot# +foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, ByteArray# #) + foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #) foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #) @@ -191,3 +205,64 @@ cloneThreadStack (ThreadId tid#) = do IO $ \s -> case sendCloneStackMessage# tid# ptr s of (# s', (# #) #) -> (# s', () #) freeStablePtr boxedPtr takeMVar resultVar + +-- | Representation for the source location where a return frame was pushed on the stack. +-- This happens every time when a @case ... of@ scrutinee is evaluated. +data StackEntry = StackEntry + { functionName :: String, + moduleName :: String, + srcLoc :: String, + closureType :: ClosureType + } + deriving (Show, Eq) + +-- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry'). +-- The stack trace is created from return frames with according 'InfoProvEnt' +-- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are +-- no 'InfoProvEnt' entries, an empty list is returned. +-- +-- Please note: +-- +-- * To gather 'StackEntry' from libraries, these have to be +-- compiled with @-finfo-table-map@, too. +-- * Due to optimizations by GHC (e.g. inlining) the stacktrace may change +-- with different GHC parameters and versions. +-- * The stack trace is empty (by design) if there are no return frames on +-- the stack. (These are pushed every time when a @case ... of@ scrutinee +-- is evaluated.) +-- +-- @since base-4.17.0.0 +decode :: StackSnapshot -> IO [StackEntry] +decode stackSnapshot = catMaybes `fmap` getDecodedStackArray stackSnapshot + +toStackEntry :: InfoProv -> StackEntry +toStackEntry infoProv = + StackEntry + { functionName = ipLabel infoProv, + moduleName = ipMod infoProv, + srcLoc = ipLoc infoProv, + closureType = ipDesc infoProv + } + +getDecodedStackArray :: StackSnapshot -> IO [Maybe StackEntry] +getDecodedStackArray (StackSnapshot s) = + IO $ \s0 -> case decodeStack# s s0 of + (# s1, arr #) -> + let n = I# (sizeofByteArray# arr) `div` wordSize - 1 + in unIO (go arr n) s1 + where + go :: ByteArray# -> Int -> IO [Maybe StackEntry] + go _stack (-1) = return [] + go stack i = do + infoProv <- lookupIPE (stackEntryAt stack i) + rest <- unsafeInterleaveIO $ go stack (i-1) + return ((toStackEntry `fmap` infoProv) : rest) + + stackEntryAt :: ByteArray# -> Int -> Ptr StgInfoTable + stackEntryAt stack (I# i) = Ptr (indexAddrArray# stack i) + + wordSize = sizeOf (nullPtr :: Ptr ()) + +prettyStackEntry :: StackEntry -> String +prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) = + " " ++ mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")" ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -14,17 +14,7 @@ {-# LANGUAGE UnliftedFFITypes #-} module GHC.Internal.Stack.Decode ( - -- * High-level stack decoders - decode, decodeStack, - decodeStackWithIpe, - -- * Stack decoder helpers - decodeStackWithFrameUnpack, - -- * StackEntry - StackEntry(..), - -- * Pretty printing - prettyStackEntry, - prettyStackFrameWithIpe, ) where @@ -34,14 +24,10 @@ import GHC.Internal.Real import GHC.Internal.Word import GHC.Internal.Num import GHC.Internal.Data.Bits -import GHC.Internal.Data.Functor -import GHC.Internal.Data.Maybe (catMaybes) import GHC.Internal.Data.List -import GHC.Internal.Data.Tuple import GHC.Internal.Foreign.Ptr import GHC.Internal.Foreign.Storable import GHC.Internal.Exts -import GHC.Internal.Unsafe.Coerce import GHC.Internal.ClosureTypes import GHC.Internal.Heap.Closures @@ -55,10 +41,8 @@ import GHC.Internal.Heap.Closures ) import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS) import GHC.Internal.Heap.InfoTable -import GHC.Internal.Stack.Annotation import GHC.Internal.Stack.Constants import GHC.Internal.Stack.CloneStack -import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE) {- Note [Decoding the stack] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -170,17 +154,14 @@ foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter -foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# -> Word# -> (# Addr#, Addr# #) +foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# --- | Get the 'StgInfoTable' of the stack frame. --- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any. -getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv) +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable getInfoTableOnStack stackSnapshot# index = - let !(# itbl_struct#, itbl_ptr_ipe_key# #) = getInfoTableAddrs# stackSnapshot# (wordOffsetToWord# index) - in - (,) <$> peekItbl (Ptr itbl_struct#) <*> lookupIPE (Ptr itbl_ptr_ipe_key#) + let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) + in peekItbl infoTablePtr getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable getInfoTableForStack stackSnapshot# = @@ -299,66 +280,18 @@ decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = (bitmapWordPointerness size bitmap) unpackStackFrame :: StackFrameLocation -> IO StackFrame -unpackStackFrame stackFrameLoc = do - unpackStackFrameTo stackFrameLoc - (\ info _ nextChunk -> do - stackClosure <- decodeStack nextChunk - pure $ - UnderflowFrame - { info_tbl = info, - nextChunk = stackClosure - } - ) - (\ frame _ -> pure frame) - -unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)] -unpackStackFrameWithIpe stackFrameLoc = do - unpackStackFrameTo stackFrameLoc - (\ info mIpe nextChunk@(StackSnapshot stack#) -> do - framesWithIpe <- decodeStackWithIpe nextChunk - pure - [ ( UnderflowFrame - { info_tbl = info, - nextChunk = - GenStgStackClosure - { ssc_info = info, - ssc_stack_size = getStackFields stack#, - ssc_stack = map fst framesWithIpe - } - } - , mIpe - ) - ] - ) - (\ frame mIpe -> pure [(frame, mIpe)]) - -unpackStackFrameTo :: - forall a . - StackFrameLocation -> - -- ^ Decode the given 'StackFrame'. - (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a) -> - -- ^ How to handle 'UNDERFLOW_FRAME's. - (StackFrame -> Maybe InfoProv -> IO a) -> - -- ^ How to handle all other 'StackFrame' values. - IO a -unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame finaliseStackFrame = do - (info, m_info_prov) <- getInfoTableOnStack stackSnapshot# index +unpackStackFrame (StackSnapshot stackSnapshot#, index) = do + info <- getInfoTableOnStack stackSnapshot# index unpackStackFrame' info - (unpackUnderflowFrame info m_info_prov) - (`finaliseStackFrame` m_info_prov) where - unpackStackFrame' :: - StgInfoTable -> - (StackSnapshot -> IO a) -> - (StackFrame -> IO a) -> - IO a - unpackStackFrame' info mkUnderflowResult mkStackFrameResult = + unpackStackFrame' :: StgInfoTable -> IO StackFrame + unpackStackFrame' info = case tipe info of RET_BCO -> do let bco' = getClosureBox stackSnapshot# (index + offsetStgClosurePayload) -- The arguments begin directly after the payload's one element bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) - mkStackFrameResult + pure RetBCO { info_tbl = info, bco = bco', @@ -367,14 +300,14 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi RET_SMALL -> let payload' = decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload in - mkStackFrameResult $ + pure $ RetSmall { info_tbl = info, stack_payload = payload' } RET_BIG -> do payload' <- decodeLargeBitmap getLargeBitmap# stackSnapshot# index offsetStgClosurePayload - mkStackFrameResult $ + pure $ RetBig { info_tbl = info, stack_payload = payload' @@ -386,7 +319,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi if isArgGenBigRetFunType stackSnapshot# index == True then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload else pure $ decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload - mkStackFrameResult $ + pure $ RetFun { info_tbl = info, retFunSize = retFunSize', @@ -396,26 +329,31 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi UPDATE_FRAME -> let updatee' = getClosureBox stackSnapshot# (index + offsetStgUpdateFrameUpdatee) in - mkStackFrameResult $ + pure $ UpdateFrame { info_tbl = info, updatee = updatee' } CATCH_FRAME -> do let handler' = getClosureBox stackSnapshot# (index + offsetStgCatchFrameHandler) - mkStackFrameResult $ + pure $ CatchFrame { info_tbl = info, handler = handler' } UNDERFLOW_FRAME -> do let nextChunk' = getUnderflowFrameNextChunk stackSnapshot# index - mkUnderflowResult nextChunk' - STOP_FRAME -> mkStackFrameResult $ StopFrame {info_tbl = info} + stackClosure <- decodeStack nextChunk' + pure $ + UnderflowFrame + { info_tbl = info, + nextChunk = stackClosure + } + STOP_FRAME -> pure $ StopFrame {info_tbl = info} ATOMICALLY_FRAME -> do let atomicallyFrameCode' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameCode) result' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameResult) - mkStackFrameResult $ + pure $ AtomicallyFrame { info_tbl = info, atomicallyFrameCode = atomicallyFrameCode', @@ -426,7 +364,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi first_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) alt_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) in - mkStackFrameResult $ + pure $ CatchRetryFrame { info_tbl = info, running_alt_code = running_alt_code', @@ -437,7 +375,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi let catchFrameCode' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameCode) handler' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameHandler) in - mkStackFrameResult $ + pure $ CatchStmFrame { info_tbl = info, catchFrameCode = catchFrameCode', @@ -446,7 +384,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi ANN_FRAME -> let annotation = getClosureBox stackSnapshot# (index + offsetStgAnnFrameAnn) in - mkStackFrameResult $ + pure $ AnnFrame { info_tbl = info, annotation = annotation @@ -464,54 +402,6 @@ intToWord# i = int2Word# (toInt# i) wordOffsetToWord# :: WordOffset -> Word# wordOffsetToWord# wo = intToWord# (fromIntegral wo) --- ---------------------------------------------------------------------------- --- Simplified source location representation of provenance information --- ---------------------------------------------------------------------------- - --- | Representation for the source location where a return frame was pushed on the stack. --- This happens every time when a @case ... of@ scrutinee is evaluated. -data StackEntry = StackEntry - { functionName :: String, - moduleName :: String, - srcLoc :: String, - closureType :: ClosureType - } - deriving (Show, Eq) - -toStackEntry :: InfoProv -> StackEntry -toStackEntry infoProv = - StackEntry - { functionName = ipLabel infoProv, - moduleName = ipMod infoProv, - srcLoc = ipLoc infoProv, - closureType = ipDesc infoProv - } - --- ---------------------------------------------------------------------------- --- Stack decoders --- ---------------------------------------------------------------------------- - --- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry'). --- The stack trace is created from return frames with according 'InfoProvEnt' --- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are --- no 'InfoProvEnt' entries, an empty list is returned. --- --- Please note: --- --- * To gather 'StackEntry' from libraries, these have to be --- compiled with @-finfo-table-map@, too. --- * Due to optimizations by GHC (e.g. inlining) the stacktrace may change --- with different GHC parameters and versions. --- * The stack trace is empty (by design) if there are no return frames on --- the stack. (These are pushed every time when a @case ... of@ scrutinee --- is evaluated.) --- --- @since base-4.17.0.0 -decode :: StackSnapshot -> IO [StackEntry] -decode stackSnapshot = - (map toStackEntry . catMaybes . map snd . reverse) <$> decodeStackWithIpe stackSnapshot - - -- | Location of a stackframe on the stack -- -- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom @@ -524,31 +414,19 @@ type StackFrameLocation = (StackSnapshot, WordOffset) -- -- See /Note [Decoding the stack]/. decodeStack :: StackSnapshot -> IO StgStackClosure -decodeStack snapshot@(StackSnapshot stack#) = do - (stackInfo, ssc_stack) <- decodeStackWithFrameUnpack unpackStackFrame snapshot - pure - GenStgStackClosure - { ssc_info = stackInfo, - ssc_stack_size = getStackFields stack#, - ssc_stack = ssc_stack - } - -decodeStackWithIpe :: StackSnapshot -> IO [(StackFrame, Maybe InfoProv)] -decodeStackWithIpe snapshot = - concat . snd <$> decodeStackWithFrameUnpack unpackStackFrameWithIpe snapshot - --- ---------------------------------------------------------------------------- --- Write your own stack decoder! --- ---------------------------------------------------------------------------- - -decodeStackWithFrameUnpack :: (StackFrameLocation -> IO a) -> StackSnapshot -> IO (StgInfoTable, [a]) -decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do +decodeStack (StackSnapshot stack#) = do info <- getInfoTableForStack stack# case tipe info of STACK -> do - let sfls = stackFrameLocations stack# - stack' <- mapM unpackFrame sfls - pure (info, stack') + let stack_size' = getStackFields stack# + sfls = stackFrameLocations stack# + stack' <- mapM unpackStackFrame sfls + pure $ + GenStgStackClosure + { ssc_info = info, + ssc_stack_size = stack_size', + ssc_stack = stack' + } _ -> error $ "Expected STACK closure, got " ++ show info where stackFrameLocations :: StackSnapshot# -> [StackFrameLocation] @@ -559,21 +437,3 @@ decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do go :: Maybe StackFrameLocation -> [StackFrameLocation] go Nothing = [] go (Just r) = r : go (advanceStackFrameLocation r) - --- ---------------------------------------------------------------------------- --- Pretty printing functions for stack entries, stack frames and provenance info --- ---------------------------------------------------------------------------- - -prettyStackFrameWithIpe :: (StackFrame, Maybe InfoProv) -> Maybe String -prettyStackFrameWithIpe (frame, mipe) = - case frame of - AnnFrame {annotation = Box someStackAnno } -> - case unsafeCoerce someStackAnno of - SomeStackAnnotation ann -> - Just $ displayStackAnnotation ann - _ -> - (prettyStackEntry . toStackEntry) <$> mipe - -prettyStackEntry :: StackEntry -> String -prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) = - mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")" ===================================== libraries/ghc-internal/tests/backtraces/T26507.hs ===================================== @@ -0,0 +1,7 @@ +import GHC.Internal.Control.Exception +import GHC.Internal.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + throwIO $ ErrorCall "Throw error" ===================================== libraries/ghc-internal/tests/backtraces/T26507.stderr ===================================== @@ -0,0 +1,8 @@ +T26507: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Throw error + +IPE backtrace: +HasCallStack backtrace: + throwIO, called at T26507.hs:7:3 in main:Main + ===================================== libraries/ghc-internal/tests/backtraces/all.T ===================================== @@ -1,2 +1,4 @@ test('T14532a', [], compile_and_run, ['']) test('T14532b', [], compile_and_run, ['']) +test('T26507', [extra_ways(['prof']), when(js_arch(), skip), exit_code(1)], compile_and_run, ['']) + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -11682,7 +11682,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13197,8 +13197,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -14717,7 +14717,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -16229,8 +16229,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -11938,7 +11938,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13469,8 +13469,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -11682,7 +11682,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13197,8 +13197,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e32a32593b03a6efc9201e0bd59d7f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e32a32593b03a6efc9201e0bd59d7f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/supersven/fix-libffi-configure-env
by Sven Tennie (＠supersven) 19 Oct '25

19 Oct '25

Sven Tennie pushed new branch wip/supersven/fix-libffi-configure-env at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/fix-libffi-configur… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/revert-backtrace-decoder] 2 commits: Revert "Implement `decode` in terms of `decodeStackWithIpe`"
by Hannes Siebenhandl (＠fendor) 19 Oct '25

19 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/revert-backtrace-decoder at Glasgow Haskell Compiler / GHC Commits: 7ec35dd8 by fendor at 2025-10-18T23:41:45+02:00 Revert "Implement `decode` in terms of `decodeStackWithIpe`" This reverts commit bd80bb7013b1c2446557a56779c88e7ad1a06259. - - - - - e32a3259 by fendor at 2025-10-18T23:41:45+02:00 Add regression test for #26507 - - - - - 14 changed files: - libraries/base/src/GHC/Stack/CloneStack.hs - libraries/ghc-internal/cbits/Stack.cmm - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/jsbits/base.js - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/src/GHC/Stack/CloneStack.hs ===================================== @@ -17,4 +17,3 @@ module GHC.Stack.CloneStack ( ) where import GHC.Internal.Stack.CloneStack -import GHC.Internal.Stack.Decode ===================================== libraries/ghc-internal/cbits/Stack.cmm ===================================== @@ -146,14 +146,14 @@ isArgGenBigRetFunTypezh(P_ stack, W_ offsetWords) { return (type); } -// (StgInfoTable*, StgInfoTable*) getInfoTableAddrszh(StgStack* stack, StgWord offsetWords) -getInfoTableAddrszh(P_ stack, W_ offsetWords) { - P_ p, info_struct, info_ptr_ipe_key; +// (StgInfoTable*) getInfoTableAddrzh(StgStack* stack, StgWord offsetWords) +getInfoTableAddrzh(P_ stack, W_ offsetWords) { + P_ p, info; p = StgStack_sp(stack) + WDS(offsetWords); ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info_struct = %GET_STD_INFO(UNTAG(p)); - info_ptr_ipe_key = %INFO_PTR(UNTAG(p)); - return (info_struct, info_ptr_ipe_key); + info = %GET_STD_INFO(UNTAG(p)); + + return (info); } // (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack) ===================================== libraries/ghc-internal/cbits/Stack_c.c ===================================== @@ -30,7 +30,7 @@ StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) { const StgInfoTable *getItbl(StgClosure *closure) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); return get_itbl(closure); -} +}; StgWord getBitmapSize(StgClosure *c) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); ===================================== libraries/ghc-internal/jsbits/base.js ===================================== @@ -1245,21 +1245,9 @@ function h$mkdir(path, path_offset, mode) { // It is required by Google Closure Compiler to be at least defined if // somewhere it is used -var h$stg_cloneMyStackzh, - h$advanceStackFrameLocationzh, h$getStackFieldszh, h$getStackClosurezh, - h$getWordzh, h$getStackInfoTableAddrzh, h$getRetFunSmallBitmapzh, h$getRetFunLargeBitmapzh, - h$isArgGenBigRetFunTypezh, - h$getUnderflowFrameNextChunkzh, - h$getInfoTableAddrszh, - h$getLargeBitmapzh, h$getSmallBitmapzh, h$getBCOLargeBitmapzh +var h$stg_cloneMyStackzh, h$stg_decodeStackzh h$stg_cloneMyStackzh - = h$advanceStackFrameLocationzh - = h$getStackFieldszh = h$getStackClosurezh - = h$getWordzh, h$getStackInfoTableAddrzh = h$getRetFunSmallBitmapzh = h$getRetFunLargeBitmapzh - = h$isArgGenBigRetFunTypezh - = h$getUnderflowFrameNextChunkzh - = h$getInfoTableAddrszh - = h$getLargeBitmapzh = h$getSmallBitmapzh = h$getBCOLargeBitmapzh + = h$stg_decodeStackzh = function () { throw new Error('Stack Cloning Decoding: Not Implemented Yet') } ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs ===================================== @@ -11,12 +11,11 @@ import GHC.Internal.IORef import GHC.Internal.IO.Unsafe (unsafePerformIO) import GHC.Internal.Exception.Context import GHC.Internal.Ptr -import GHC.Internal.Data.Maybe (fromMaybe, mapMaybe) +import GHC.Internal.Data.Maybe (fromMaybe) import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack) import qualified GHC.Internal.Stack as HCS import qualified GHC.Internal.ExecutionStack.Internal as ExecStack import qualified GHC.Internal.Stack.CloneStack as CloneStack -import qualified GHC.Internal.Stack.Decode as CloneStack import qualified GHC.Internal.Stack.CCS as CCS -- | How to collect a backtrace when an exception is thrown. @@ -144,7 +143,7 @@ displayBacktraces bts = concat displayExec = unlines . map (indent 2 . flip ExecStack.showLocation "") . fromMaybe [] . ExecStack.stackFrames -- The unsafePerformIO here is safe as 'StackSnapshot' makes sure neither the stack frames nor -- references closures can be garbage collected. - displayIpe = unlines . mapMaybe (fmap (indent 2) . CloneStack.prettyStackFrameWithIpe) . unsafePerformIO . CloneStack.decodeStackWithIpe + displayIpe = unlines . map (indent 2 . CloneStack.prettyStackEntry) . unsafePerformIO . CloneStack.decode displayHsc = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack where prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs ===================================== @@ -15,20 +15,34 @@ -- @since base-4.17.0.0 module GHC.Internal.Stack.CloneStack ( StackSnapshot(..), + StackEntry(..), cloneMyStack, cloneThreadStack, + decode, + prettyStackEntry ) where import GHC.Internal.MVar +import GHC.Internal.Data.Maybe (catMaybes) import GHC.Internal.Base +import GHC.Internal.Foreign.Storable import GHC.Internal.Conc.Sync +import GHC.Internal.IO (unsafeInterleaveIO) +import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE, StgInfoTable) +import GHC.Internal.Num +import GHC.Internal.Real (div) import GHC.Internal.Stable +import GHC.Internal.Text.Show +import GHC.Internal.Ptr +import GHC.Internal.ClosureTypes -- | A frozen snapshot of the state of an execution stack. -- -- @since base-4.17.0.0 data StackSnapshot = StackSnapshot !StackSnapshot# +foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, ByteArray# #) + foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #) foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #) @@ -191,3 +205,64 @@ cloneThreadStack (ThreadId tid#) = do IO $ \s -> case sendCloneStackMessage# tid# ptr s of (# s', (# #) #) -> (# s', () #) freeStablePtr boxedPtr takeMVar resultVar + +-- | Representation for the source location where a return frame was pushed on the stack. +-- This happens every time when a @case ... of@ scrutinee is evaluated. +data StackEntry = StackEntry + { functionName :: String, + moduleName :: String, + srcLoc :: String, + closureType :: ClosureType + } + deriving (Show, Eq) + +-- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry'). +-- The stack trace is created from return frames with according 'InfoProvEnt' +-- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are +-- no 'InfoProvEnt' entries, an empty list is returned. +-- +-- Please note: +-- +-- * To gather 'StackEntry' from libraries, these have to be +-- compiled with @-finfo-table-map@, too. +-- * Due to optimizations by GHC (e.g. inlining) the stacktrace may change +-- with different GHC parameters and versions. +-- * The stack trace is empty (by design) if there are no return frames on +-- the stack. (These are pushed every time when a @case ... of@ scrutinee +-- is evaluated.) +-- +-- @since base-4.17.0.0 +decode :: StackSnapshot -> IO [StackEntry] +decode stackSnapshot = catMaybes `fmap` getDecodedStackArray stackSnapshot + +toStackEntry :: InfoProv -> StackEntry +toStackEntry infoProv = + StackEntry + { functionName = ipLabel infoProv, + moduleName = ipMod infoProv, + srcLoc = ipLoc infoProv, + closureType = ipDesc infoProv + } + +getDecodedStackArray :: StackSnapshot -> IO [Maybe StackEntry] +getDecodedStackArray (StackSnapshot s) = + IO $ \s0 -> case decodeStack# s s0 of + (# s1, arr #) -> + let n = I# (sizeofByteArray# arr) `div` wordSize - 1 + in unIO (go arr n) s1 + where + go :: ByteArray# -> Int -> IO [Maybe StackEntry] + go _stack (-1) = return [] + go stack i = do + infoProv <- lookupIPE (stackEntryAt stack i) + rest <- unsafeInterleaveIO $ go stack (i-1) + return ((toStackEntry `fmap` infoProv) : rest) + + stackEntryAt :: ByteArray# -> Int -> Ptr StgInfoTable + stackEntryAt stack (I# i) = Ptr (indexAddrArray# stack i) + + wordSize = sizeOf (nullPtr :: Ptr ()) + +prettyStackEntry :: StackEntry -> String +prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) = + " " ++ mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")" ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -14,17 +14,7 @@ {-# LANGUAGE UnliftedFFITypes #-} module GHC.Internal.Stack.Decode ( - -- * High-level stack decoders - decode, decodeStack, - decodeStackWithIpe, - -- * Stack decoder helpers - decodeStackWithFrameUnpack, - -- * StackEntry - StackEntry(..), - -- * Pretty printing - prettyStackEntry, - prettyStackFrameWithIpe, ) where @@ -34,10 +24,7 @@ import GHC.Internal.Real import GHC.Internal.Word import GHC.Internal.Num import GHC.Internal.Data.Bits -import GHC.Internal.Data.Functor -import GHC.Internal.Data.Maybe (catMaybes) import GHC.Internal.Data.List -import GHC.Internal.Data.Tuple import GHC.Internal.Foreign.Ptr import GHC.Internal.Foreign.Storable import GHC.Internal.Exts @@ -58,7 +45,6 @@ import GHC.Internal.Heap.InfoTable import GHC.Internal.Stack.Annotation import GHC.Internal.Stack.Constants import GHC.Internal.Stack.CloneStack -import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE) {- Note [Decoding the stack] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -170,17 +156,14 @@ foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter -foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# -> Word# -> (# Addr#, Addr# #) +foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# --- | Get the 'StgInfoTable' of the stack frame. --- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any. -getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv) +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable getInfoTableOnStack stackSnapshot# index = - let !(# itbl_struct#, itbl_ptr_ipe_key# #) = getInfoTableAddrs# stackSnapshot# (wordOffsetToWord# index) - in - (,) <$> peekItbl (Ptr itbl_struct#) <*> lookupIPE (Ptr itbl_ptr_ipe_key#) + let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) + in peekItbl infoTablePtr getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable getInfoTableForStack stackSnapshot# = @@ -299,66 +282,18 @@ decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = (bitmapWordPointerness size bitmap) unpackStackFrame :: StackFrameLocation -> IO StackFrame -unpackStackFrame stackFrameLoc = do - unpackStackFrameTo stackFrameLoc - (\ info _ nextChunk -> do - stackClosure <- decodeStack nextChunk - pure $ - UnderflowFrame - { info_tbl = info, - nextChunk = stackClosure - } - ) - (\ frame _ -> pure frame) - -unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)] -unpackStackFrameWithIpe stackFrameLoc = do - unpackStackFrameTo stackFrameLoc - (\ info mIpe nextChunk@(StackSnapshot stack#) -> do - framesWithIpe <- decodeStackWithIpe nextChunk - pure - [ ( UnderflowFrame - { info_tbl = info, - nextChunk = - GenStgStackClosure - { ssc_info = info, - ssc_stack_size = getStackFields stack#, - ssc_stack = map fst framesWithIpe - } - } - , mIpe - ) - ] - ) - (\ frame mIpe -> pure [(frame, mIpe)]) - -unpackStackFrameTo :: - forall a . - StackFrameLocation -> - -- ^ Decode the given 'StackFrame'. - (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a) -> - -- ^ How to handle 'UNDERFLOW_FRAME's. - (StackFrame -> Maybe InfoProv -> IO a) -> - -- ^ How to handle all other 'StackFrame' values. - IO a -unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame finaliseStackFrame = do - (info, m_info_prov) <- getInfoTableOnStack stackSnapshot# index +unpackStackFrame (StackSnapshot stackSnapshot#, index) = do + info <- getInfoTableOnStack stackSnapshot# index unpackStackFrame' info - (unpackUnderflowFrame info m_info_prov) - (`finaliseStackFrame` m_info_prov) where - unpackStackFrame' :: - StgInfoTable -> - (StackSnapshot -> IO a) -> - (StackFrame -> IO a) -> - IO a - unpackStackFrame' info mkUnderflowResult mkStackFrameResult = + unpackStackFrame' :: StgInfoTable -> IO StackFrame + unpackStackFrame' info = case tipe info of RET_BCO -> do let bco' = getClosureBox stackSnapshot# (index + offsetStgClosurePayload) -- The arguments begin directly after the payload's one element bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) - mkStackFrameResult + pure RetBCO { info_tbl = info, bco = bco', @@ -367,14 +302,14 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi RET_SMALL -> let payload' = decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload in - mkStackFrameResult $ + pure $ RetSmall { info_tbl = info, stack_payload = payload' } RET_BIG -> do payload' <- decodeLargeBitmap getLargeBitmap# stackSnapshot# index offsetStgClosurePayload - mkStackFrameResult $ + pure $ RetBig { info_tbl = info, stack_payload = payload' @@ -386,7 +321,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi if isArgGenBigRetFunType stackSnapshot# index == True then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload else pure $ decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload - mkStackFrameResult $ + pure $ RetFun { info_tbl = info, retFunSize = retFunSize', @@ -396,26 +331,31 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi UPDATE_FRAME -> let updatee' = getClosureBox stackSnapshot# (index + offsetStgUpdateFrameUpdatee) in - mkStackFrameResult $ + pure $ UpdateFrame { info_tbl = info, updatee = updatee' } CATCH_FRAME -> do let handler' = getClosureBox stackSnapshot# (index + offsetStgCatchFrameHandler) - mkStackFrameResult $ + pure $ CatchFrame { info_tbl = info, handler = handler' } UNDERFLOW_FRAME -> do let nextChunk' = getUnderflowFrameNextChunk stackSnapshot# index - mkUnderflowResult nextChunk' - STOP_FRAME -> mkStackFrameResult $ StopFrame {info_tbl = info} + stackClosure <- decodeStack nextChunk' + pure $ + UnderflowFrame + { info_tbl = info, + nextChunk = stackClosure + } + STOP_FRAME -> pure $ StopFrame {info_tbl = info} ATOMICALLY_FRAME -> do let atomicallyFrameCode' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameCode) result' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameResult) - mkStackFrameResult $ + pure $ AtomicallyFrame { info_tbl = info, atomicallyFrameCode = atomicallyFrameCode', @@ -426,7 +366,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi first_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) alt_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) in - mkStackFrameResult $ + pure $ CatchRetryFrame { info_tbl = info, running_alt_code = running_alt_code', @@ -437,7 +377,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi let catchFrameCode' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameCode) handler' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameHandler) in - mkStackFrameResult $ + pure $ CatchStmFrame { info_tbl = info, catchFrameCode = catchFrameCode', @@ -446,7 +386,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi ANN_FRAME -> let annotation = getClosureBox stackSnapshot# (index + offsetStgAnnFrameAnn) in - mkStackFrameResult $ + pure $ AnnFrame { info_tbl = info, annotation = annotation @@ -464,54 +404,6 @@ intToWord# i = int2Word# (toInt# i) wordOffsetToWord# :: WordOffset -> Word# wordOffsetToWord# wo = intToWord# (fromIntegral wo) --- ---------------------------------------------------------------------------- --- Simplified source location representation of provenance information --- ---------------------------------------------------------------------------- - --- | Representation for the source location where a return frame was pushed on the stack. --- This happens every time when a @case ... of@ scrutinee is evaluated. -data StackEntry = StackEntry - { functionName :: String, - moduleName :: String, - srcLoc :: String, - closureType :: ClosureType - } - deriving (Show, Eq) - -toStackEntry :: InfoProv -> StackEntry -toStackEntry infoProv = - StackEntry - { functionName = ipLabel infoProv, - moduleName = ipMod infoProv, - srcLoc = ipLoc infoProv, - closureType = ipDesc infoProv - } - --- ---------------------------------------------------------------------------- --- Stack decoders --- ---------------------------------------------------------------------------- - --- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry'). --- The stack trace is created from return frames with according 'InfoProvEnt' --- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are --- no 'InfoProvEnt' entries, an empty list is returned. --- --- Please note: --- --- * To gather 'StackEntry' from libraries, these have to be --- compiled with @-finfo-table-map@, too. --- * Due to optimizations by GHC (e.g. inlining) the stacktrace may change --- with different GHC parameters and versions. --- * The stack trace is empty (by design) if there are no return frames on --- the stack. (These are pushed every time when a @case ... of@ scrutinee --- is evaluated.) --- --- @since base-4.17.0.0 -decode :: StackSnapshot -> IO [StackEntry] -decode stackSnapshot = - (map toStackEntry . catMaybes . map snd . reverse) <$> decodeStackWithIpe stackSnapshot - - -- | Location of a stackframe on the stack -- -- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom @@ -524,31 +416,19 @@ type StackFrameLocation = (StackSnapshot, WordOffset) -- -- See /Note [Decoding the stack]/. decodeStack :: StackSnapshot -> IO StgStackClosure -decodeStack snapshot@(StackSnapshot stack#) = do - (stackInfo, ssc_stack) <- decodeStackWithFrameUnpack unpackStackFrame snapshot - pure - GenStgStackClosure - { ssc_info = stackInfo, - ssc_stack_size = getStackFields stack#, - ssc_stack = ssc_stack - } - -decodeStackWithIpe :: StackSnapshot -> IO [(StackFrame, Maybe InfoProv)] -decodeStackWithIpe snapshot = - concat . snd <$> decodeStackWithFrameUnpack unpackStackFrameWithIpe snapshot - --- ---------------------------------------------------------------------------- --- Write your own stack decoder! --- ---------------------------------------------------------------------------- - -decodeStackWithFrameUnpack :: (StackFrameLocation -> IO a) -> StackSnapshot -> IO (StgInfoTable, [a]) -decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do +decodeStack (StackSnapshot stack#) = do info <- getInfoTableForStack stack# case tipe info of STACK -> do - let sfls = stackFrameLocations stack# - stack' <- mapM unpackFrame sfls - pure (info, stack') + let stack_size' = getStackFields stack# + sfls = stackFrameLocations stack# + stack' <- mapM unpackStackFrame sfls + pure $ + GenStgStackClosure + { ssc_info = info, + ssc_stack_size = stack_size', + ssc_stack = stack' + } _ -> error $ "Expected STACK closure, got " ++ show info where stackFrameLocations :: StackSnapshot# -> [StackFrameLocation] @@ -559,21 +439,3 @@ decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do go :: Maybe StackFrameLocation -> [StackFrameLocation] go Nothing = [] go (Just r) = r : go (advanceStackFrameLocation r) - --- ---------------------------------------------------------------------------- --- Pretty printing functions for stack entries, stack frames and provenance info --- ---------------------------------------------------------------------------- - -prettyStackFrameWithIpe :: (StackFrame, Maybe InfoProv) -> Maybe String -prettyStackFrameWithIpe (frame, mipe) = - case frame of - AnnFrame {annotation = Box someStackAnno } -> - case unsafeCoerce someStackAnno of - SomeStackAnnotation ann -> - Just $ displayStackAnnotation ann - _ -> - (prettyStackEntry . toStackEntry) <$> mipe - -prettyStackEntry :: StackEntry -> String -prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) = - mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")" ===================================== libraries/ghc-internal/tests/backtraces/T26507.hs ===================================== @@ -0,0 +1,7 @@ +import GHC.Internal.Control.Exception +import GHC.Internal.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + throwIO $ ErrorCall "Throw error" ===================================== libraries/ghc-internal/tests/backtraces/T26507.stderr ===================================== @@ -0,0 +1,8 @@ +T26507: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Throw error + +IPE backtrace: +HasCallStack backtrace: + throwIO, called at T26507.hs:7:3 in main:Main + ===================================== libraries/ghc-internal/tests/backtraces/all.T ===================================== @@ -1,2 +1,4 @@ test('T14532a', [], compile_and_run, ['']) test('T14532b', [], compile_and_run, ['']) +test('T26507', [extra_ways(['prof']), when(js_arch(), skip), exit_code(1)], compile_and_run, ['']) + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -11682,7 +11682,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13197,8 +13197,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -14717,7 +14717,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -16229,8 +16229,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -11938,7 +11938,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13469,8 +13469,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -11682,7 +11682,7 @@ instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in instance GHC.Internal.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’ instance GHC.Internal.Classes.Eq GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’ -instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Internal.Classes.Eq (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’ instance GHC.Internal.Classes.Eq GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’ instance forall (c :: GHC.Internal.Types.Char). GHC.Internal.Classes.Eq (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’ @@ -13197,8 +13197,7 @@ instance GHC.Internal.Show.Show GHC.RTS.Flags.ProfFlags -- Defined in ‘GHC.RTS instance GHC.Internal.Show.Show GHC.RTS.Flags.RTSFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TickyFlags -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Show.Show GHC.RTS.Flags.TraceFlags -- Defined in ‘GHC.RTS.Flags’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.Pointerness -- Defined in ‘GHC.Internal.Stack.Decode’ -instance GHC.Internal.Show.Show GHC.Internal.Stack.Decode.StackEntry -- Defined in ‘GHC.Internal.Stack.Decode’ +instance GHC.Internal.Show.Show GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’ instance GHC.Internal.Show.Show GHC.Internal.StaticPtr.StaticPtrInfo -- Defined in ‘GHC.Internal.StaticPtr’ instance [safe] GHC.Internal.Show.Show GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’ instance [safe] GHC.Internal.Show.Show GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3606aa3e088cc3c2331160efbc607… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3606aa3e088cc3c2331160efbc607… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Cmm Parser: Fix incorrect example in comment
by Marge Bot (＠marge-bot) 19 Oct '25

19 Oct '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 26b8a414 by Diego Antonio Rosario Palomino at 2025-10-18T16:58:10-04:00 Cmm Parser: Fix incorrect example in comment The Parser.y file contains a comment with an incorrect example of textual Cmm (used in .cmm files). This commit updates the comment to ensure it reflects valid textual Cmm syntax. Fixes #26313 - - - - - 1 changed file: - compiler/GHC/Cmm/Parser.y Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -60,7 +60,7 @@ bar x = R1; // the calling convention is explicit: better be careful // that this works on all platforms! - jump %ENTRY_CODE(Sp(0)) + jump %ENTRY_CODE(Sp(0))[]; } Here is a list of rules for high-level and low-level code. If you View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26b8a4140fb8b96f64b668c4ff7f200… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26b8a4140fb8b96f64b668c4ff7f200… You're receiving this email because of your account on gitlab.haskell.org.

1 0