Matthew Pickering pushed to branch wip/26507 at Glasgow Haskell Compiler / GHC Commits: 38d65187 by Matthew Pickering at 2025-10-21T13:12:20+01:00 Fix stack decoding when using profiled runtime There are three fixes in this commit. * We need to replicate the `InfoTable` and `InfoTableProf` approach for the other stack constants (see the new Stack.ConstantsProf file). * Then we need to appropiately import the profiled or non-profiled versions. * Finally, there was an incorrect addition in `stackFrameSize`. We need to cast after performing addition on words. Fixes #26507 - - - - - 17231bfb by fendor at 2025-10-21T13:12:20+01:00 Add regression test for #26507 - - - - - 8 changed files: - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - 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 - libraries/ghc-internal/tests/stack-annotation/all.T Changes: ===================================== libraries/ghc-internal/cbits/Stack_c.c ===================================== @@ -9,13 +9,13 @@ #include "rts/storage/InfoTables.h" StgWord stackFrameSize(StgStack *stack, StgWord offset) { - StgClosure *c = (StgClosure *)stack->sp + offset; + StgClosure *c = (StgClosure *)(stack->sp + offset); ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); return stack_frame_sizeW(c); } StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) { - StgClosure *frame = (StgClosure *)stack->sp + offset; + StgClosure *frame = (StgClosure *)(stack->sp + offset); ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame)); const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame); ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -300,6 +300,7 @@ Library GHC.Internal.Stack.CCS GHC.Internal.Stack.CloneStack GHC.Internal.Stack.Constants + GHC.Internal.Stack.ConstantsProf GHC.Internal.Stack.Decode GHC.Internal.Stack.Types GHC.Internal.Stats ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GHC.Internal.Stack.ConstantsProf where + +import GHC.Internal.Base +import GHC.Internal.Enum +import GHC.Internal.Num +import GHC.Internal.Show +import GHC.Internal.Real + +-- This file is a copy of GHC.Internal.Stack.Constants, but compiled with PROFILING +-- defined, since hsc is only invoked once per build in the vanilla way. +-- +-- Also see GHC.Internal.Heap.InfoTable{Prof} +#define PROFILING +#include "Rts.h" +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#undef BLOCKS_PER_MBLOCK +#include "DerivedConstants.h" + +newtype ByteOffset = ByteOffset { offsetInBytes :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +newtype WordOffset = WordOffset { offsetInWords :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +offsetStgCatchFrameHandler :: WordOffset +offsetStgCatchFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchFrame_handler) + (#size StgHeader) + +sizeStgCatchFrame :: Int +sizeStgCatchFrame = bytesToWords $ + (#const SIZEOF_StgCatchFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchSTMFrameCode :: WordOffset +offsetStgCatchSTMFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_code) + (#size StgHeader) + +offsetStgCatchSTMFrameHandler :: WordOffset +offsetStgCatchSTMFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_handler) + (#size StgHeader) + +sizeStgCatchSTMFrame :: Int +sizeStgCatchSTMFrame = bytesToWords $ + (#const SIZEOF_StgCatchSTMFrame_NoHdr) + (#size StgHeader) + +offsetStgUpdateFrameUpdatee :: WordOffset +offsetStgUpdateFrameUpdatee = byteOffsetToWordOffset $ + (#const OFFSET_StgUpdateFrame_updatee) + (#size StgHeader) + +sizeStgUpdateFrame :: Int +sizeStgUpdateFrame = bytesToWords $ + (#const SIZEOF_StgUpdateFrame_NoHdr) + (#size StgHeader) + +offsetStgAtomicallyFrameCode :: WordOffset +offsetStgAtomicallyFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_code) + (#size StgHeader) + +offsetStgAtomicallyFrameResult :: WordOffset +offsetStgAtomicallyFrameResult = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_result) + (#size StgHeader) + +sizeStgAtomicallyFrame :: Int +sizeStgAtomicallyFrame = bytesToWords $ + (#const SIZEOF_StgAtomicallyFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningAltCode :: WordOffset +offsetStgCatchRetryFrameRunningAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_running_alt_code) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningFirstCode :: WordOffset +offsetStgCatchRetryFrameRunningFirstCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_first_code) + (#size StgHeader) + +offsetStgCatchRetryFrameAltCode :: WordOffset +offsetStgCatchRetryFrameAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_alt_code) + (#size StgHeader) + +sizeStgCatchRetryFrame :: Int +sizeStgCatchRetryFrame = bytesToWords $ + (#const SIZEOF_StgCatchRetryFrame_NoHdr) + (#size StgHeader) + +offsetStgRetFunFrameSize :: WordOffset +-- StgRetFun has no header, but only a pointer to the info table at the beginning. +offsetStgRetFunFrameSize = byteOffsetToWordOffset (#const OFFSET_StgRetFun_size) + +offsetStgRetFunFrameFun :: WordOffset +offsetStgRetFunFrameFun = byteOffsetToWordOffset (#const OFFSET_StgRetFun_fun) + +offsetStgRetFunFramePayload :: WordOffset +offsetStgRetFunFramePayload = byteOffsetToWordOffset (#const OFFSET_StgRetFun_payload) + +sizeStgRetFunFrame :: Int +sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) + +sizeStgAnnFrame :: Int +sizeStgAnnFrame = bytesToWords $ + (#const SIZEOF_StgAnnFrame_NoHdr) + (#size StgHeader) + +offsetStgAnnFrameAnn :: WordOffset +offsetStgAnnFrameAnn = byteOffsetToWordOffset $ + (#const OFFSET_StgAnnFrame_ann) + (#size StgHeader) + +offsetStgBCOFrameInstrs :: ByteOffset +offsetStgBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader) + +offsetStgBCOFrameLiterals :: ByteOffset +offsetStgBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader) + +offsetStgBCOFramePtrs :: ByteOffset +offsetStgBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader) + +offsetStgBCOFrameArity :: ByteOffset +offsetStgBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader) + +offsetStgBCOFrameSize :: ByteOffset +offsetStgBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader) + +offsetStgClosurePayload :: WordOffset +offsetStgClosurePayload = byteOffsetToWordOffset $ + (#const OFFSET_StgClosure_payload) + (#size StgHeader) + +sizeStgClosure :: Int +sizeStgClosure = bytesToWords (#size StgHeader) + +byteOffsetToWordOffset :: ByteOffset -> WordOffset +byteOffsetToWordOffset = WordOffset . bytesToWords . fromInteger . toInteger + +bytesToWords :: Int -> Int +bytesToWords b = + if b `mod` bytesInWord == 0 then + fromIntegral $ b `div` bytesInWord + else + error "Unexpected struct alignment!" + +bytesInWord :: Int +bytesInWord = (#const SIZEOF_VOID_P) + ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -54,9 +54,19 @@ import GHC.Internal.Heap.Closures GenStackField(..) ) import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS) -import GHC.Internal.Heap.InfoTable import GHC.Internal.Stack.Annotation +-- See Note [No way-dependent imports] +#if defined(PROFILING) +import GHC.Internal.Stack.Constants () +import GHC.Internal.Stack.ConstantsProf +import GHC.Internal.Heap.InfoTable () +import GHC.Internal.Heap.InfoTableProf +#else +import GHC.Internal.Heap.InfoTable +import GHC.Internal.Heap.InfoTableProf () import GHC.Internal.Stack.Constants +import GHC.Internal.Stack.ConstantsProf () +#endif import GHC.Internal.Stack.CloneStack import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE) ===================================== 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,6 @@ test('T14532a', [], compile_and_run, ['']) test('T14532b', [], compile_and_run, ['']) +test('T26507', [ when(have_profiling(), extra_ways(['prof'])) + , when(js_arch(), skip) + , exit_code(1)], compile_and_run, ['']) + ===================================== libraries/ghc-internal/tests/stack-annotation/all.T ===================================== @@ -1,7 +1,10 @@ # Javascript backend don't support annotation frames, yet -setTestOpts(when(js_arch(), skip)) +# and test with profiling way if available (#26507) +ann_frame_opts = [ when(js_arch(), skip) + , when(have_profiling(), extra_ways(['prof'])) + , extra_files(['TestUtils.hs'])] -test('ann_frame001', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame002', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame003', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame004', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) +test('ann_frame001', ann_frame_opts, compile_and_run, ['']) +test('ann_frame002', ann_frame_opts, compile_and_run, ['']) +test('ann_frame003', ann_frame_opts, compile_and_run, ['']) +test('ann_frame004', ann_frame_opts, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbadb892167932288950dc44f57f42... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbadb892167932288950dc44f57f42... You're receiving this email because of your account on gitlab.haskell.org.