GitLab

Ben Gamari pushed to branch wip/decode-orig-update-frames at Glasgow Haskell Compiler / GHC

Commits:

d0789dfe

by Ben Gamari at 2026-06-21T10:19:10-04:00

ghc-heap: Expose OrigThunkInfo frames

Introduce a new constructor to StgStackFrame which exposes
orig_update_frames, allowing better backtraces when this feature is
enabled.

3 changed files:

libraries/ghc-internal/cbits/Stack.cmm
libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs

Changes:

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/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/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'.
 +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