[Git][ghc/ghc][wip/backports-9.14] 3 commits: Fix stack decoding when using profiled runtime

27 Oct 2025

Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC


Commits:
c5e71a10 by Matthew Pickering at 2025-10-27T07:49:45-04: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

- - - - -
a0fc61dc by fendor at 2025-10-27T07:49:46-04:00
Add regression test for #26507

- - - - -
6cb2ffde by Teo Camarasu at 2025-10-27T18:32:45-04:00
Add submodules for template-haskell-lift and template-haskell-quasiquoter

These two new boot libraries expose stable subsets of the
template-haskell interface.

This is an implemenation of the GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/696

Work towards #25262

(cherry picked from commit 4be32153febff94f9c89f7f74971da3721d19c87)

- - - - -


15 changed files:

- .gitmodules
- hadrian/src/Packages.hs
- hadrian/src/Settings/Default.hs
- 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/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.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
- + libraries/template-haskell-lift
- + libraries/template-haskell-quasiquoter


Changes:

=====================================
.gitmodules
=====================================
@@ -118,3 +118,9 @@
 [submodule "libraries/file-io"]
 	path = libraries/file-io
 	url = https://gitlab.haskell.org/ghc/packages/file-io.git
+[submodule "libraries/template-haskell-lift"]
+	path = libraries/template-haskell-lift
+	url = https://gitlab.haskell.org/ghc/template-haskell-lift.git
+[submodule "libraries/template-haskell-quasiquoter"]
+	path = libraries/template-haskell-quasiquoter
+	url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git


=====================================
hadrian/src/Packages.hs
=====================================
@@ -9,7 +9,7 @@ module Packages (
     ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline,
     hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy,
     libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts,
-    runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout,
+    runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, timeout,
     transformers, unlit, unix, win32, xhtml,
     lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
     ghcPackages, isGhcPackage,
@@ -39,7 +39,7 @@ ghcPackages =
     , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim
     , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs
     , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString
-    , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
+    , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, thLift, thQuasiquoter
     , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio
     , timeout
     , lintersCommon
@@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count
   ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim,
   ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs,
   hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl,
-  osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
+  osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter,
   terminfo, text, time, transformers, unlit, unix, win32, xhtml,
   timeout,
   lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
@@ -124,6 +124,8 @@ runGhc              = util "runghc"
 semaphoreCompat     = lib  "semaphore-compat"
 stm                 = lib  "stm"
 templateHaskell     = lib  "template-haskell"
+thLift              = lib  "template-haskell-lift"
+thQuasiquoter       = lib  "template-haskell-quasiquoter"
 terminfo            = lib  "terminfo"
 text                = lib  "text"
 time                = lib  "time"


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -106,6 +106,8 @@ stage0Packages = do
              , runGhc
              , semaphoreCompat -- depends on
              , time -- depends on win32
+             , thLift -- new library not yet present for boot compilers
+             , thQuasiquoter -- new library not yet present for boot compilers
              , unlit
              , if windowsHost then win32 else unix
              -- We must use the in-tree `Win32` as the version


=====================================
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/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -20,7 +20,7 @@
 -- | This module gives the definition of the 'Lift' class.
 --
 -- This is an internal module.

--- Please import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
+-- Please import "Language.Haskell.TH.Lift", "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
 
 module GHC.Internal.TH.Lift
   ( Lift(..)
@@ -70,6 +70,9 @@ import GHC.Internal.ForeignPtr
 -- >   deriving Lift
 --
 -- Representation-polymorphic since /template-haskell-2.16.0.0/.
+--
+-- This is exposed both from the @template-haskell-lift@ and @template-haskell@ packages.
+-- Consider importing it from the more stable @template-haskell-lift@ if you don't need the full breadth of the @template-haskell@ interface.
 class Lift (t :: TYPE r) where
   -- | Turn a value into a Template Haskell expression, suitable for use in
   -- a splice.


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
=====================================
@@ -30,6 +30,9 @@ import GHC.Internal.Base hiding (Type)
 -- in defining a quasiquoter to be used for expressions, you would
 -- define a 'QuasiQuoter' with only 'quoteExp', and leave the other
 -- fields stubbed out with errors.
+--
+-- This is exposed both from the @template-haskell-quasiquoter@ and @template-haskell@ packages.
+-- Consider importing it from the more stable @template-haskell-quasiquoter@ if you don't need the full breadth of the @template-haskell@ interface.
 data QuasiQuoter = QuasiQuoter {
     -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@
     quoteExp  :: String -> Q Exp,


=====================================
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, [''])


=====================================
libraries/template-haskell-lift
=====================================
@@ -0,0 +1 @@
+Subproject commit 2b63f282bee11fec5aa68a18c535afbe8212165a


=====================================
libraries/template-haskell-quasiquoter
=====================================
@@ -0,0 +1 @@
+Subproject commit 615e73cae78eade99684b562215d1e5af30fb3ee



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dad0b2486ea3b8cc94d326700ee17f...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dad0b2486ea3b8cc94d326700ee17f...
You're receiving this email because of your account on gitlab.haskell.org.

    

Ben Gamari (＠bgamari)

tags

participants (1)