diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 029ee68809ad7abceed3fbd518b81229d4cb6333..e92dc068d4b237654e9f0087752eb65567a49f58 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -68,6 +68,7 @@ Library
         , Control.Concurrent.MVar
         , Control.Exception
         , Control.Exception.Annotation
+        , Control.Exception.Backtrace
         , Control.Exception.Base
         , Control.Exception.Context
         , Control.Monad
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 4d9f7c2698aa28ac20c7ce4f070667d51c3e2e17..5d3af3ff34e0371a51e2effa9c8716b730d72e40 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -12,6 +12,10 @@
   * Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
   * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
   * Exceptions can now be decorated with user-defined annotations via `ExceptionContext`.
+  * Exceptions now capture backtrace information via their `ExceptionContext`. GHC
+    supports several mechanisms by which backtraces can be collected which can be
+    individually enabled and disabled via
+    `GHC.Exception.Backtrace.setEnabledBacktraceMechanisms`.
   * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
   * Fix `withFile`, `withFileBlocking`, and `withBinaryFile` to not incorrectly annotate exceptions raised in wrapped computation. ([CLC proposal #237](https://github.com/haskell/core-libraries-committee/issues/237))
   * Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`
diff --git a/libraries/base/tests/IO/T21336/T21336a.stderr b/libraries/base/tests/IO/T21336/T21336a.stderr
index ad668363f7b6792a22831c5eec57f791fdea75da..85f334fff340c23ebe79ee9daa89a5243265a76d 100644
--- a/libraries/base/tests/IO/T21336/T21336a.stderr
+++ b/libraries/base/tests/IO/T21336/T21336a.stderr
@@ -1 +1,8 @@
 Exception during weak pointer finalization (ignored): GHC.Internal.IO.FD.fdWrite: resource exhausted (No space left on device)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs:452:17 in ghc-internal:GHC.Internal.IO.Handle.Internals
+
+
+
diff --git a/libraries/base/tests/IO/T21336/T21336b.stderr b/libraries/base/tests/IO/T21336/T21336b.stderr
index 2e702f81e7f455cae22f4d3119eb410f23238ed4..fb1f599d1a088a4bc442c31aa418ec20f04c668f 100644
--- a/libraries/base/tests/IO/T21336/T21336b.stderr
+++ b/libraries/base/tests/IO/T21336/T21336b.stderr
@@ -1 +1,9 @@
 Exception during weak pointer finalization (ignored): <stdout>: hFlush: resource exhausted (No space left on device)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/T4808.stderr b/libraries/base/tests/IO/T4808.stderr
index 0b7a89fb80f3c2157c5924fa6a28b71f41c5b9f7..3c6ef411abc985a3c1a70a863033af93bb39f629 100644
--- a/libraries/base/tests/IO/T4808.stderr
+++ b/libraries/base/tests/IO/T4808.stderr
@@ -1 +1,9 @@
 T4808: T4808.test: hGetLine: illegal operation (handle is closed)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/mkdirExists.stderr b/libraries/base/tests/IO/mkdirExists.stderr
index 4d12490fa6c9d30d8d44311ac6b63cc5379f0757..85c727d23c878475c1c1b12bdd8e24d1609bc711 100644
--- a/libraries/base/tests/IO/mkdirExists.stderr
+++ b/libraries/base/tests/IO/mkdirExists.stderr
@@ -1 +1,9 @@
 mkdirExists: foo: createDirectory: already exists (File exists)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/openFile002.stderr b/libraries/base/tests/IO/openFile002.stderr
index b011f34146a04031645c8323914536a672b54875..740d6b1cad2e4602209fbee9e104642a2bde817d 100644
--- a/libraries/base/tests/IO/openFile002.stderr
+++ b/libraries/base/tests/IO/openFile002.stderr
@@ -1 +1,9 @@
 openFile002: nonexistent: openFile: does not exist (No such file or directory)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/openFile002.stderr-mingw32 b/libraries/base/tests/IO/openFile002.stderr-mingw32
index a75cc496f4cf23c15275f71fe814e55c7bc82a32..fd33f838324b84dd2299561e91f7d4e59a122468 100644
--- a/libraries/base/tests/IO/openFile002.stderr-mingw32
+++ b/libraries/base/tests/IO/openFile002.stderr-mingw32
@@ -1 +1,6 @@
 openFile002.exe: nonexistent: openFile: does not exist (The system cannot find the file specified.)
+HasCallStack backtrace:
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:<line>:<column> in <package-id>:GHC.Internal.IO
+  throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
+  ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
diff --git a/libraries/base/tests/IO/withBinaryFile001.stderr b/libraries/base/tests/IO/withBinaryFile001.stderr
index 1f38884260f770e6f7f22daa90dbce3e87c48fcc..e3c44c40e178d42af501441a73ab9d07e560b515 100644
--- a/libraries/base/tests/IO/withBinaryFile001.stderr
+++ b/libraries/base/tests/IO/withBinaryFile001.stderr
@@ -1 +1,9 @@
 withBinaryFile001: test.bin: withBinaryFile: does not exist (No such file or directory)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/withBinaryFile002.stderr b/libraries/base/tests/IO/withBinaryFile002.stderr
index ea881b4b1d69df29326bb6bde530b98804a6fcc0..3bea0c702c40f94cb65f12764fcf133d22df4e6b 100644
--- a/libraries/base/tests/IO/withBinaryFile002.stderr
+++ b/libraries/base/tests/IO/withBinaryFile002.stderr
@@ -1 +1,9 @@
 withBinaryFile002: user error (test)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/withFile001.stderr b/libraries/base/tests/IO/withFile001.stderr
index a0528a115a7cb1d6b2be18394c8fb3179d4f48a2..fb5c0ae974144866d7913356f6d9266d73b955e5 100644
--- a/libraries/base/tests/IO/withFile001.stderr
+++ b/libraries/base/tests/IO/withFile001.stderr
@@ -1 +1,9 @@
 withFile001: test.txt: withFile: does not exist (No such file or directory)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/withFile002.stderr b/libraries/base/tests/IO/withFile002.stderr
index 44f058c7e6eb20bf722df1cb66dbfb4aaf491a19..f0e918427d930f80028eeef9dcc3a2a6141c6227 100644
--- a/libraries/base/tests/IO/withFile002.stderr
+++ b/libraries/base/tests/IO/withFile002.stderr
@@ -1 +1,9 @@
 withFile002: user error (test)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/withFileBlocking001.stderr b/libraries/base/tests/IO/withFileBlocking001.stderr
index ff15fcbc1f58aa007ef033f775ba16c75bc2e00c..929f6963a66cbba92ca13d78fdc151cf480b929b 100644
--- a/libraries/base/tests/IO/withFileBlocking001.stderr
+++ b/libraries/base/tests/IO/withFileBlocking001.stderr
@@ -1 +1,9 @@
 withFileBlocking001: test.txt: withFileBlocking: does not exist (No such file or directory)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/IO/withFileBlocking002.stderr b/libraries/base/tests/IO/withFileBlocking002.stderr
index be85ab47d1edae34d0e29a32546715a18f2da2b9..15ed3291116f151146bcb0aa7e5205c526f1baaa 100644
--- a/libraries/base/tests/IO/withFileBlocking002.stderr
+++ b/libraries/base/tests/IO/withFileBlocking002.stderr
@@ -1 +1,9 @@
 withFileBlocking002: user error (test)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:315:19 in ghc-internal:GHC.Internal.IO.Exception
+    ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:319:20 in ghc-internal:GHC.Internal.IO.Exception
+
+
+
diff --git a/libraries/base/tests/T15349.stderr b/libraries/base/tests/T15349.stderr
index 9cb080d93e023e6d0e2a2d5b5cf83d02bdcfb7e9..0917e4a8f224e5c4d03c414d2669185d3c4ebac6 100644
--- a/libraries/base/tests/T15349.stderr
+++ b/libraries/base/tests/T15349.stderr
@@ -1 +1,8 @@
 T15349: <<loop>>
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs:58:37 in ghc-internal:GHC.Internal.Control.Monad.ST.Imp
+
+
+
diff --git a/libraries/base/tests/T19288.stderr b/libraries/base/tests/T19288.stderr
index 68f83bff836884875b42e01968568bc616b0ea7c..13e48cd7acfb6f184b39bacf52707f31d10792b0 100644
--- a/libraries/base/tests/T19288.stderr
+++ b/libraries/base/tests/T19288.stderr
@@ -1,3 +1,9 @@
 T19288: No more bug!
 CallStack (from HasCallStack):
   error, called at T19288.hs:25:27 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/libraries/base/tests/assert.stderr b/libraries/base/tests/assert.stderr
index 2f809bd466b0f851fcbf53971a8fd6da57e5c00d..0d727656b956fc9ad0037fdede1e1ff3fa518a6f 100644
--- a/libraries/base/tests/assert.stderr
+++ b/libraries/base/tests/assert.stderr
@@ -1,3 +1,11 @@
 assert: Assertion failed
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   assert, called at assert.hs:9:11 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
+    assert, called at assert.hs:9:11 in main:Main
+
+
+
diff --git a/libraries/base/tests/topHandler04.stderr b/libraries/base/tests/topHandler04.stderr
index e9bba9e480d84991fa0182795e10002733071297..3c1a51f1f5e43d585069dcde3732127e0ed18588 100644
--- a/libraries/base/tests/topHandler04.stderr
+++ b/libraries/base/tests/topHandler04.stderr
@@ -1,2 +1,9 @@
 topHandler04: error
 out-of-band
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at topHandler04.hs:5:8 in main:Main
+
+
+
diff --git a/libraries/ghc-internal/ghc-internal.cabal b/libraries/ghc-internal/ghc-internal.cabal
index bb19cc67c20e937dc119c5097c50e198ba10e9fe..646e2ae02df235a3b91063e78ecbf7e08747e33a 100644
--- a/libraries/ghc-internal/ghc-internal.cabal
+++ b/libraries/ghc-internal/ghc-internal.cabal
@@ -181,6 +181,7 @@ Library
         GHC.Internal.Err
         GHC.Internal.Event.TimeOut
         GHC.Internal.Exception
+        GHC.Internal.Exception.Backtrace
         GHC.Internal.Exception.Context
         GHC.Internal.Exception.Type
         GHC.Internal.ExecutionStack
diff --git a/libraries/ghc-internal/src/GHC/Internal/Exception.hs b/libraries/ghc-internal/src/GHC/Internal/Exception.hs
index 04649e643f0dc6d2317c4f207324ebb02d365fd9..1aabfb1e56accbfc25a8dd99a2e816fe4b2783f8 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Exception.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Exception.hs
@@ -54,6 +54,7 @@ module GHC.Internal.Exception
     , ErrorCall(..,ErrorCall)
     , errorCallException
     , errorCallWithCallStackException
+    , toExceptionWithBacktrace
 
       -- * Reexports
       -- Re-export CallStack and SrcLoc from GHC.Types
@@ -69,6 +70,7 @@ import GHC.Internal.Data.OldList
 import GHC.Internal.IO.Unsafe
 import {-# SOURCE #-} GHC.Internal.Stack.CCS
 import {-# SOURCE #-} GHC.Internal.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc)
+import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectBacktraces)
 import GHC.Internal.Exception.Type
 
 -- | Throw an exception.  Exceptions may be thrown from purely
@@ -77,8 +79,19 @@ import GHC.Internal.Exception.Type
 -- WARNING: You may want to use 'throwIO' instead so that your pure code
 -- stays exception-free.
 throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
-         Exception e => e -> a
-throw e = raise# (toException e)
+         (?callStack :: CallStack, Exception e) => e -> a
+throw e =
+    let !se = unsafePerformIO (toExceptionWithBacktrace e)
+    in raise# se
+
+-- | @since base-4.20.0.0
+toExceptionWithBacktrace :: (HasCallStack, Exception e)
+                         => e -> IO SomeException
+toExceptionWithBacktrace e
+  | backtraceDesired e = do
+      bt <- collectBacktraces
+      return (addExceptionContext bt (toException e))
+  | otherwise = return (toException e)
 
 -- | This is thrown when the user calls 'error'. The first @String@ is the
 -- argument given to 'error', second @String@ is the location.
@@ -112,7 +125,7 @@ errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
     implicitParamCallStack = prettyCallStackLines stk
     ccsCallStack = showCCSStack ccsStack
     stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
-  return $ toException (ErrorCallWithLocation s stack)
+  toExceptionWithBacktrace (ErrorCallWithLocation s stack)
 
 showCCSStack :: [String] -> [String]
 showCCSStack [] = []
diff --git a/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs b/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e917987ebbab2fff6813383858b55f5a2337e174
--- /dev/null
+++ b/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+
+module GHC.Internal.Exception.Backtrace
+    ( -- * Backtrace mechanisms
+      BacktraceMechanism(..)
+    , getBacktraceMechanismState
+    , setBacktraceMechanismState
+      -- * Collecting backtraces
+    , Backtraces
+    , displayBacktraces
+    , collectBacktraces
+    ) where
+
+import GHC.Internal.Base
+import GHC.Internal.Data.OldList
+import GHC.Internal.IORef
+import GHC.Internal.IO.Unsafe (unsafePerformIO)
+import GHC.Internal.Exception.Context
+import GHC.Internal.Ptr
+import GHC.Internal.Stack.Types as GHC.Stack (CallStack)
+import qualified GHC.Internal.Stack as HCS
+import qualified GHC.Internal.ExecutionStack as ExecStack
+import qualified GHC.Internal.ExecutionStack.Internal as ExecStack
+import qualified GHC.Internal.Stack.CloneStack as CloneStack
+import qualified GHC.Internal.Stack.CCS as CCS
+
+-- | How to collect a backtrace when an exception is thrown.
+data BacktraceMechanism
+  -- | collect cost-centre stack backtraces (only available when built with profiling)
+  = CostCentreBacktrace
+  -- | collect 'HasCallStack' backtraces
+  | HasCallStackBacktrace
+  -- | collect backtraces from native execution stack unwinding
+  | ExecutionBacktrace
+  -- | collect backtraces from Info Table Provenance Entries
+  | IPEBacktrace
+
+data EnabledBacktraceMechanisms =
+    EnabledBacktraceMechanisms
+      { costCentreBacktraceEnabled   :: !Bool
+      , hasCallStackBacktraceEnabled :: !Bool
+      , executionBacktraceEnabled    :: !Bool
+      , ipeBacktraceEnabled          :: !Bool
+      }
+
+defaultEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms
+defaultEnabledBacktraceMechanisms = EnabledBacktraceMechanisms
+  { costCentreBacktraceEnabled   = False
+  , hasCallStackBacktraceEnabled = True
+  , executionBacktraceEnabled    = False
+  , ipeBacktraceEnabled          = False
+  }
+
+backtraceMechanismEnabled :: BacktraceMechanism -> EnabledBacktraceMechanisms -> Bool
+backtraceMechanismEnabled bm =
+  case bm of
+    CostCentreBacktrace   -> costCentreBacktraceEnabled
+    HasCallStackBacktrace -> hasCallStackBacktraceEnabled
+    ExecutionBacktrace    -> executionBacktraceEnabled
+    IPEBacktrace          -> ipeBacktraceEnabled
+
+setBacktraceMechanismEnabled
+    :: BacktraceMechanism -> Bool
+    -> EnabledBacktraceMechanisms
+    -> EnabledBacktraceMechanisms
+setBacktraceMechanismEnabled bm enabled en =
+    case bm of
+      CostCentreBacktrace   -> en { costCentreBacktraceEnabled = enabled }
+      HasCallStackBacktrace -> en { hasCallStackBacktraceEnabled = enabled }
+      ExecutionBacktrace    -> en { executionBacktraceEnabled = enabled }
+      IPEBacktrace          -> en { ipeBacktraceEnabled = enabled }
+
+enabledBacktraceMechanismsRef :: IORef EnabledBacktraceMechanisms
+enabledBacktraceMechanismsRef =
+    unsafePerformIO $ newIORef defaultEnabledBacktraceMechanisms
+{-# NOINLINE enabledBacktraceMechanismsRef #-}
+
+-- | Returns the currently enabled 'BacktraceMechanism's.
+getEnabledBacktraceMechanisms :: IO EnabledBacktraceMechanisms
+getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanismsRef
+
+-- | Will the given 'BacktraceMechanism' be used when collecting
+-- backtraces?
+getBacktraceMechanismState :: BacktraceMechanism -> IO Bool
+getBacktraceMechanismState bm =
+    backtraceMechanismEnabled bm `fmap` getEnabledBacktraceMechanisms
+
+-- | Set whether the given 'BacktraceMechanism' will be used when collecting
+-- backtraces?
+setBacktraceMechanismState :: BacktraceMechanism -> Bool -> IO ()
+setBacktraceMechanismState bm enabled = do
+    _ <- atomicModifyIORef'_ enabledBacktraceMechanismsRef (setBacktraceMechanismEnabled bm enabled)
+    return ()
+
+-- | A collection of backtraces.
+data Backtraces =
+    Backtraces {
+        btrCostCentre :: Maybe (Ptr CCS.CostCentreStack),
+        btrHasCallStack :: Maybe HCS.CallStack,
+        btrExecutionStack :: Maybe [ExecStack.Location],
+        btrIpe :: Maybe [CloneStack.StackEntry]
+    }
+
+-- | Render a set of backtraces to a human-readable string.
+displayBacktraces :: Backtraces -> String
+displayBacktraces bts = concat
+    [ displayOne "Cost-centre stack backtrace" btrCostCentre displayCc
+    , displayOne "Native stack backtrace" btrExecutionStack displayExec
+    , displayOne "IPE backtrace" btrIpe displayIpe
+    , displayOne "HasCallStack backtrace" btrHasCallStack displayHsc
+    ]
+  where
+    indent :: Int -> String -> String
+    indent n s  = replicate n ' ' ++ s
+
+    -- The unsafePerformIO here is safe as we don't currently unload cost-centres.
+    displayCc   = unlines . map (indent 2) . unsafePerformIO . CCS.ccsToStrings
+    displayExec = unlines . map (indent 2 . flip ExecStack.showLocation "")
+    displayIpe  = unlines . map (indent 2 . CloneStack.prettyStackEntry)
+    displayHsc  = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack
+      where prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc
+
+    displayOne :: String -> (Backtraces -> Maybe rep) -> (rep -> String) -> String
+    displayOne label getBt displ
+      | Just bt <- getBt bts = concat [label, ":\n", displ bt]
+      | otherwise            = ""
+
+instance ExceptionAnnotation Backtraces where
+    displayExceptionAnnotation = displayBacktraces
+
+-- | Collect a set of 'Backtraces'.
+collectBacktraces :: (?callStack :: CallStack) => IO Backtraces
+collectBacktraces = HCS.withFrozenCallStack $ do
+    getEnabledBacktraceMechanisms >>= collectBacktraces'
+
+collectBacktraces'
+    :: (?callStack :: CallStack)
+    => EnabledBacktraceMechanisms -> IO Backtraces
+collectBacktraces' enabled = HCS.withFrozenCallStack $ do
+    let collect :: BacktraceMechanism -> IO (Maybe a) -> IO (Maybe a)
+        collect mech f
+          | backtraceMechanismEnabled mech enabled = f
+          | otherwise = return Nothing
+
+    ccs <- collect CostCentreBacktrace $ do
+        Just `fmap` CCS.getCurrentCCS ()
+
+    exec <- collect ExecutionBacktrace $ do
+        ExecStack.getStackTrace
+
+    ipe <- collect IPEBacktrace $ do
+        stack <- CloneStack.cloneMyStack
+        stackEntries <- CloneStack.decode stack
+        return (Just stackEntries)
+
+    hcs <- collect HasCallStackBacktrace $ do
+        return (Just ?callStack)
+
+    return (Backtraces { btrCostCentre = ccs
+                       , btrHasCallStack = hcs
+                       , btrExecutionStack = exec
+                       , btrIpe = ipe
+                       })
diff --git a/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
new file mode 100644
index 0000000000000000000000000000000000000000..e8b99c4b515b359c11a07a3000e8b14ea1f00109
--- /dev/null
+++ b/libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
@@ -0,0 +1,15 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+module GHC.Internal.Exception.Backtrace where
+
+import GHC.Internal.Base (IO)
+import GHC.Internal.Stack.Types (HasCallStack)
+import GHC.Internal.Exception.Context (ExceptionAnnotation)
+
+data Backtraces
+
+instance ExceptionAnnotation Backtraces
+
+-- For GHC.Exception
+collectBacktraces :: HasCallStack => IO Backtraces
diff --git a/libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs b/libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
index c79daebab6687a003ccc727830a4fd31b914d499..819a0ae079a6f5691902b0f0726d1338edee4b03 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
@@ -32,6 +32,7 @@ module GHC.Internal.Exception.Type
        , someExceptionContext
        , addExceptionContext
        , mapExceptionContext
+       , NoBacktrace(..)
          -- * Exception context
        , HasExceptionContext
        , ExceptionContext(..)
@@ -181,6 +182,9 @@ class (Typeable e, Show e) => Exception e where
     displayException :: e -> String
     displayException = show
 
+    backtraceDesired :: e -> Bool
+    backtraceDesired _ = True
+
 -- | @since base-4.8.0.0
 instance Exception Void
 
@@ -192,6 +196,7 @@ instance Exception SomeException where
         let ?exceptionContext = emptyExceptionContext
         in SomeException e
     fromException = Just
+    backtraceDesired (SomeException e) = backtraceDesired e
     displayException (SomeException e) =
         displayException e ++ "\n" ++ displayContext ?exceptionContext
 
@@ -201,6 +206,14 @@ displayContext (ExceptionContext anns0) = go anns0
     go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
     go [] = ""
 
+newtype NoBacktrace e = NoBacktrace e
+    deriving (Show)
+
+instance Exception e => Exception (NoBacktrace e) where
+    fromException = fmap NoBacktrace . fromException
+    toException (NoBacktrace e) = toException e
+    backtraceDesired _ = False
+
 -- | Wraps a particular exception exposing its 'ExceptionContext'. Intended to
 -- be used when 'catch'ing exceptions in cases where access to the context is
 -- desired.
@@ -216,6 +229,7 @@ instance Exception a => Exception (ExceptionWithContext a) where
     fromException se = do
         e <- fromException se
         return (ExceptionWithContext (someExceptionContext se) e)
+    backtraceDesired (ExceptionWithContext _ e) = backtraceDesired e
     displayException = displayException . toException
 
 -- |Arithmetic exceptions.
diff --git a/libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc b/libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
index e9a79806853e9911b40bdfdfeffc0bcd7b12088c..fdaf4bf9fc7a2af697b191f4f32c8ffdaaf01a19 100644
--- a/libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
+++ b/libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
@@ -27,6 +27,7 @@
 module GHC.Internal.ExecutionStack.Internal (
   -- * Internal
     Location (..)
+  , showLocation
   , SrcLoc (..)
   , StackTrace
   , stackFrames
diff --git a/libraries/ghc-internal/src/GHC/Internal/IO.hs b/libraries/ghc-internal/src/GHC/Internal/IO.hs
index 7faf1a6bc0672aea6b1b75cdc9bb328200dc6ff3..aa0546587d8510a9d23e22ed99dad1c1cf5834ca 100644
--- a/libraries/ghc-internal/src/GHC/Internal/IO.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/IO.hs
@@ -51,12 +51,13 @@ module GHC.Internal.IO (
 import GHC.Internal.Base
 import GHC.Internal.ST
 import GHC.Internal.Exception
-import GHC.Internal.Exception.Type (addExceptionContext)
+import GHC.Internal.Exception.Type (NoBacktrace(..))
 import GHC.Internal.Show
 import GHC.Internal.IO.Unsafe
 import GHC.Internal.Unsafe.Coerce ( unsafeCoerce )
 
 import GHC.Internal.Exception.Context ( ExceptionAnnotation )
+import GHC.Internal.Stack.Types ( HasCallStack )
 import {-# SOURCE #-} GHC.Internal.IO.Exception ( userError, IOError )
 
 -- ---------------------------------------------------------------------------
@@ -254,8 +255,10 @@ mplusIO m n = m `catchException` \ (_ :: IOError) -> n
 -- for a more technical introduction to how GHC optimises around precise vs.
 -- imprecise exceptions.
 --
-throwIO :: Exception e => e -> IO a
-throwIO e = IO (raiseIO# (toException e))
+throwIO :: (HasCallStack, Exception e) => e -> IO a
+throwIO e = do
+    se <- toExceptionWithBacktrace e
+    IO (raiseIO# se)
 
 -- -----------------------------------------------------------------------------
 -- Controlling asynchronous exception delivery
@@ -329,8 +332,9 @@ getMaskingState  = IO $ \s ->
                              _  -> MaskedInterruptible #)
 
 onException :: IO a -> IO b -> IO a
-onException io what = io `catchException` \e -> do _ <- what
-                                                   throwIO (e :: SomeException)
+onException io what = io `catchException` \e -> do
+    _ <- what
+    throwIO $ NoBacktrace (e :: SomeException)
 
 -- | Executes an IO computation with asynchronous
 -- exceptions /masked/.  That is, any thread which attempts to raise
diff --git a/libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs b/libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
index 908952d5b555a9257b611549313d714620638219..0983be07f0bb48f3f323d6c945790f87aa7ff6c5 100644
--- a/libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
@@ -61,6 +61,7 @@ import GHC.Internal.Exception
 import GHC.Internal.IO.Handle.Types
 import GHC.Internal.Data.OldList ( intercalate )
 import {-# SOURCE #-} GHC.Internal.Stack.CCS
+import GHC.Internal.Stack.Types (HasCallStack)
 import GHC.Internal.Foreign.C.Types
 
 import GHC.Internal.Data.Typeable ( cast )
@@ -310,7 +311,7 @@ data ExitCode
 -- | @since base-4.1.0.0
 instance Exception ExitCode
 
-ioException     :: IOException -> IO a
+ioException     :: HasCallStack => IOException -> IO a
 ioException err = throwIO err
 
 -- | Raise an 'IOError' in the 'IO' monad.
diff --git a/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs b/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
index adf02bb1b8aa2c8e9020e823b221ad60407331b9..6e209a55219952e7348471ce62a4a8e63d596467 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
@@ -18,7 +18,8 @@ module GHC.Internal.Stack.CloneStack (
   StackEntry(..),
   cloneMyStack,
   cloneThreadStack,
-  decode
+  decode,
+  prettyStackEntry
   ) where
 
 import GHC.Internal.MVar
@@ -263,3 +264,7 @@ getDecodedStackArray (StackSnapshot s) =
     stackEntryAt :: Array# (Ptr InfoProvEnt) -> Int -> Ptr InfoProvEnt
     stackEntryAt stack (I# i) = case indexArray# stack i of
       (# se #) -> se
+
+prettyStackEntry :: StackEntry -> String
+prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) =
+    "  " ++ mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")"
diff --git a/testsuite/tests/arityanal/should_run/T21694a.stderr b/testsuite/tests/arityanal/should_run/T21694a.stderr
index 8a0fd0cc91da95312b51512bc190dcde9d503b8b..db2b03c1a9198cf7e8f924ff3a350a8d2706bc38 100644
--- a/testsuite/tests/arityanal/should_run/T21694a.stderr
+++ b/testsuite/tests/arityanal/should_run/T21694a.stderr
@@ -1,3 +1,9 @@
 T21694a: Urkh! But expected!
 CallStack (from HasCallStack):
-  error, called at T21694a.hs:23:33 in main:Main
+  error, called at T21694a.hs:24:33 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/arityanal/should_run/T24296.stderr b/testsuite/tests/arityanal/should_run/T24296.stderr
index 84ca18adae58065402efee03f61de5ac14e4d55c..062ceeb5a186c974f16028a9f4d9c5362462893b 100644
--- a/testsuite/tests/arityanal/should_run/T24296.stderr
+++ b/testsuite/tests/arityanal/should_run/T24296.stderr
@@ -1,3 +1,9 @@
 T24296: tricky called with at least two args
 CallStack (from HasCallStack):
   error, called at T24296.hs:12:7 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/arrows/should_compile/T21301.stderr b/testsuite/tests/arrows/should_compile/T21301.stderr
index ac9dc1185840b999f2247e75a072e3e80f346070..49f649148de0de2fe3122511bba539bd9f07c17b 100644
--- a/testsuite/tests/arrows/should_compile/T21301.stderr
+++ b/testsuite/tests/arrows/should_compile/T21301.stderr
@@ -1 +1,9 @@
 T21301: T21301.hs:(8,7)-(10,6): Non-exhaustive patterns in case
+
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/T16846.stderr b/testsuite/tests/codeGen/should_run/T16846.stderr
index 3d1cbeef105e459f6d5637a36d299cd7d89eb8cf..f37b7b2b20168cc46f2f612e4b717f31af895923 100644
--- a/testsuite/tests/codeGen/should_run/T16846.stderr
+++ b/testsuite/tests/codeGen/should_run/T16846.stderr
@@ -1,3 +1,9 @@
 T16846: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T16846.hs:22:3 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/T5626.stderr b/testsuite/tests/codeGen/should_run/T5626.stderr
index 921c69a8cd94f982077c04af68fee32fa1a23071..8823bbcdcddc926900e57c85ef691647c0d631dc 100644
--- a/testsuite/tests/codeGen/should_run/T5626.stderr
+++ b/testsuite/tests/codeGen/should_run/T5626.stderr
@@ -1,3 +1,9 @@
 T5626: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T5626.hs:6:30 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/cgrun025.stderr b/testsuite/tests/codeGen/should_run/cgrun025.stderr
index 35ad64c79c7f051069b1d52e9393764cea36252f..72f53e8e3b806f01aff96d75ef1ae23b354f62c0 100644
--- a/testsuite/tests/codeGen/should_run/cgrun025.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun025.stderr
@@ -30,3 +30,9 @@ hello, trace
 cgrun025: hello, error
 CallStack (from HasCallStack):
   error, called at cgrun025.hs:25:75 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/cgrun045.stderr b/testsuite/tests/codeGen/should_run/cgrun045.stderr
index d7f8188c8b5f62b093bc3128954a9032f5eeafc8..07d10e474c8febd095c54f6e5e1b5299b1d26557 100644
--- a/testsuite/tests/codeGen/should_run/cgrun045.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun045.stderr
@@ -1,3 +1,9 @@
 cgrun045: hello world!
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at cgrun045.hs:6:13 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/cgrun051.stderr b/testsuite/tests/codeGen/should_run/cgrun051.stderr
index 432dd5649b9e594803272ba45dbd073797ada219..2f72aafacf3281ba25b08c116ed6d4809e149810 100644
--- a/testsuite/tests/codeGen/should_run/cgrun051.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun051.stderr
@@ -1,3 +1,9 @@
 cgrun051: OK
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at cgrun051.hs:7:25 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/codeGen/should_run/cgrun059.stderr b/testsuite/tests/codeGen/should_run/cgrun059.stderr
index da868fc522541f46444bcf62634e76bed1e343db..2bbac8354f11ed162a311c0b41964037d32e1ff6 100644
--- a/testsuite/tests/codeGen/should_run/cgrun059.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun059.stderr
@@ -1,3 +1,9 @@
 cgrun059: Error: File not found
 CallStack (from HasCallStack):
   error, called at cgrun059.hs:12:28 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/concurrent/should_run/T13330.stderr b/testsuite/tests/concurrent/should_run/T13330.stderr
index 9eecb6456756c566f4624f6f8efb2c8ff1a1111e..0d9c9bc557db59b6683f6d1c1e801055b2e883dd 100644
--- a/testsuite/tests/concurrent/should_run/T13330.stderr
+++ b/testsuite/tests/concurrent/should_run/T13330.stderr
@@ -1,3 +1,9 @@
 T13330: Successful exception
 CallStack (from HasCallStack):
   error, called at T13330.hs:5:16 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/concurrent/should_run/conc021.stderr b/testsuite/tests/concurrent/should_run/conc021.stderr
index 659f3257263431854a6db31610ff6f252df0c823..200788036c2a2fde2eaa35dd6f19c8cc9015de01 100644
--- a/testsuite/tests/concurrent/should_run/conc021.stderr
+++ b/testsuite/tests/concurrent/should_run/conc021.stderr
@@ -1,3 +1,9 @@
 conc021: wurble
 CallStack (from HasCallStack):
   error, called at conc021.hs:9:9 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
index a863168277eec8a843982c8ad583477a512cd55d..ef2249937c87e36dad94cf95e2b385b642e13717 100644
--- a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
+++ b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
@@ -1,2 +1,9 @@
 DsStrictFail: DsStrictFail.hs:4:12-23: Non-exhaustive patterns in False
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/T11193.stderr b/testsuite/tests/deSugar/should_run/T11193.stderr
index 50e427c048c28325887e47b6902357630fc953ba..f2639e6058e8c13bf202ef5a1ef4faf8c7bf45a6 100644
--- a/testsuite/tests/deSugar/should_run/T11193.stderr
+++ b/testsuite/tests/deSugar/should_run/T11193.stderr
@@ -1,3 +1,9 @@
 T11193: error here!
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at T11193.hs:7:16 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/T11572.stderr b/testsuite/tests/deSugar/should_run/T11572.stderr
index c4a5ee0044a1b13f3307c9235216544660a6b8d2..ee0e54eb06100856964c55833469ed43910e44e8 100644
--- a/testsuite/tests/deSugar/should_run/T11572.stderr
+++ b/testsuite/tests/deSugar/should_run/T11572.stderr
@@ -1,3 +1,9 @@
 T11572: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T11572.hs:6:18 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/T11601.stderr b/testsuite/tests/deSugar/should_run/T11601.stderr
index 29f6bef2972c14eee703a0106100f2ff931f645a..c22c7a4cc00cd7d253ce05bdbc1d76392334b004 100644
--- a/testsuite/tests/deSugar/should_run/T11601.stderr
+++ b/testsuite/tests/deSugar/should_run/T11601.stderr
@@ -1,3 +1,9 @@
 T11601: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T11601.hs:6:35 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/T20024.stderr b/testsuite/tests/deSugar/should_run/T20024.stderr
index 24e6227fdc08ee94ea2dfdc2d7558005e0ef78b7..1bd791433a7a72e1f6f07ffbe144b62e7ea13f6e 100644
--- a/testsuite/tests/deSugar/should_run/T20024.stderr
+++ b/testsuite/tests/deSugar/should_run/T20024.stderr
@@ -1,2 +1,9 @@
 T20024: T20024.hs:2:12-32: Non-exhaustive guards in pattern binding
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:419:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/dsrun005.stderr b/testsuite/tests/deSugar/should_run/dsrun005.stderr
index 73718fc858a77bf14d21e8c0480ec29a5b6f149f..34df77153d5855ca1a5badd3f465dabaee8be873 100644
--- a/testsuite/tests/deSugar/should_run/dsrun005.stderr
+++ b/testsuite/tests/deSugar/should_run/dsrun005.stderr
@@ -1,2 +1,9 @@
 dsrun005: dsrun005.hs:42:1-18: Non-exhaustive patterns in function f
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/dsrun007.stderr b/testsuite/tests/deSugar/should_run/dsrun007.stderr
index f3136338031bbccf37942f74ff02936836d3b91b..dd92a9fef37ebd15d02789e8fe90ebb6ddba3a11 100644
--- a/testsuite/tests/deSugar/should_run/dsrun007.stderr
+++ b/testsuite/tests/deSugar/should_run/dsrun007.stderr
@@ -1,2 +1,9 @@
 dsrun007: dsrun007.hs:5:23-25: Missing field in record construction 
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:420:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/deSugar/should_run/dsrun008.stderr b/testsuite/tests/deSugar/should_run/dsrun008.stderr
index b40f7458a8e863f34bb113428ec1fb3db1117c7c..b2ab27d6f634c45cec38071c2e4f457d30a1d597 100644
--- a/testsuite/tests/deSugar/should_run/dsrun008.stderr
+++ b/testsuite/tests/deSugar/should_run/dsrun008.stderr
@@ -1,2 +1,9 @@
 dsrun008: dsrun008.hs:2:32-36: Non-exhaustive patterns in (2, x)
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/deriving/should_run/T9576.stderr b/testsuite/tests/deriving/should_run/T9576.stderr
index 78f979a54d3436cc9e726b31db518b390f4de457..633cfa63c378f3802ca43302ac95e6b113041430 100644
--- a/testsuite/tests/deriving/should_run/T9576.stderr
+++ b/testsuite/tests/deriving/should_run/T9576.stderr
@@ -1,4 +1,4 @@
-T9576.exe: T9576.hs:6:31: error: [GHC-39999]
+T9576: T9576.hs:6:31: error: [GHC-39999]
     • No instance for ‘Show Foo’ arising from a use of ‘showsPrec’
     • In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
       In the second argument of ‘showParen’, namely
@@ -9,3 +9,10 @@ T9576.exe: T9576.hs:6:31: error: [GHC-39999]
         in a derived instance for ‘Show Bar’:
         To see the code I am typechecking, use -ddump-deriv
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/T12368.stderr b/testsuite/tests/dmdanal/should_run/T12368.stderr
index 05025ac78e7b382911148c52270a2320523247cf..02c64fe554bbede8130ec86c42bea667ff969aba 100644
--- a/testsuite/tests/dmdanal/should_run/T12368.stderr
+++ b/testsuite/tests/dmdanal/should_run/T12368.stderr
@@ -1,3 +1,9 @@
 T12368: This is good!
 CallStack (from HasCallStack):
-  error, called at T12368.hs:24:22 in main:Main
+  error, called at T12368.hs:23:22 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/T12368a.stderr b/testsuite/tests/dmdanal/should_run/T12368a.stderr
index 98246d33d016f25d55a9ba4e952e77e97a2b4bad..696af57485e2aef61b846f6af60e6f9bf5c9e0ed 100644
--- a/testsuite/tests/dmdanal/should_run/T12368a.stderr
+++ b/testsuite/tests/dmdanal/should_run/T12368a.stderr
@@ -1,3 +1,9 @@
 T12368a: This is good!
 CallStack (from HasCallStack):
   error, called at T12368a.hs:22:17 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/T13380.stderr b/testsuite/tests/dmdanal/should_run/T13380.stderr
index 6fa8811bdde495619309a45c275843c56b52855f..87d141b80a82fbe26a0964e21bf4f79228ef10a1 100644
--- a/testsuite/tests/dmdanal/should_run/T13380.stderr
+++ b/testsuite/tests/dmdanal/should_run/T13380.stderr
@@ -1 +1,8 @@
 T13380: user error (What)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at T13380.hs:6:21 in main:Main
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/T13380e.stderr b/testsuite/tests/dmdanal/should_run/T13380e.stderr
index d118d7a50a697c0362ea696439d693707deb815d..fad445f023e05a4cda8ea74e5779af81f7f3d81d 100644
--- a/testsuite/tests/dmdanal/should_run/T13380e.stderr
+++ b/testsuite/tests/dmdanal/should_run/T13380e.stderr
@@ -1 +1,8 @@
 T13380e: user error (What)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at T13380e.hs:8:10 in main:Main
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/T23208.stderr b/testsuite/tests/dmdanal/should_run/T23208.stderr
index 3d71f0be648f1ec5574ab36907bfe9591350d3b1..3c5dbf581de3bd08317c1c8e9a6fea5ae96ff762 100644
--- a/testsuite/tests/dmdanal/should_run/T23208.stderr
+++ b/testsuite/tests/dmdanal/should_run/T23208.stderr
@@ -1,3 +1,9 @@
 T23208: really important message
 CallStack (from HasCallStack):
   error, called at T23208_Lib.hs:4:7 in main:T23208_Lib
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/dmdanal/should_run/strun002.stderr b/testsuite/tests/dmdanal/should_run/strun002.stderr
index 735b981a88a89ca6064e1993dda0b52c0a773d9a..70c3c0f5d458d377fedea1eeb76b66f539089333 100644
--- a/testsuite/tests/dmdanal/should_run/strun002.stderr
+++ b/testsuite/tests/dmdanal/should_run/strun002.stderr
@@ -1,3 +1,9 @@
 strun002: Variable not found: (2) hello
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at strun002.hs:7:11 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/driver/T13914/T13914.stdout b/testsuite/tests/driver/T13914/T13914.stdout
index 94053406d6870280f1fdc004a951bb8eb61a04bd..79028998e65c8e63280fc72acf81d775f0de3010 100644
--- a/testsuite/tests/driver/T13914/T13914.stdout
+++ b/testsuite/tests/driver/T13914/T13914.stdout
@@ -4,6 +4,12 @@ Without -fignore-asserts
 main: Assertion failed
 CallStack (from HasCallStack):
   assert, called at main.hs:3:8 in main:Main
+HasCallStack backtrace:
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+  throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
+  assert, called at main.hs:3:8 in main:Main
+
 
 With -fignore-asserts
 [1 of 2] Compiling Main             ( main.hs, main.o ) [Optimisation flags changed]
@@ -15,4 +21,10 @@ Without -fignore-asserts
 main: Assertion failed
 CallStack (from HasCallStack):
   assert, called at main.hs:3:8 in main:Main
+HasCallStack backtrace:
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+  throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
+  assert, called at main.hs:3:8 in main:Main
+
 
diff --git a/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_callstack.stderr b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_callstack.stderr
index 0d7d75b1ee9061aaae440eff65826049dbbdc859..8b8b2022015c79bba8344755e0e2a8ecd8b920b4 100644
--- a/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_callstack.stderr
+++ b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_callstack.stderr
@@ -1,3 +1,9 @@
 Main: test
 CallStack (from HasCallStack):
   error, called at callstack/./Main.hs:4:8 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/ffi/should_run/T7170.stderr b/testsuite/tests/ffi/should_run/T7170.stderr
index 4ea63ebc4e56d667e34fcc72f08592cfacb0d79b..069f5cfe61595742f616fcb61d5a3effabf44364 100644
--- a/testsuite/tests/ffi/should_run/T7170.stderr
+++ b/testsuite/tests/ffi/should_run/T7170.stderr
@@ -1 +1,8 @@
 T7170: thread blocked indefinitely in an MVar operation
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:195:43 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/ffi/should_run/ffi008.stderr b/testsuite/tests/ffi/should_run/ffi008.stderr
index 83999ed16e9526d5a0522c3120e3d177d395c5fb..4e1036efbec43b198740fc801499bd24b2d2ea68 100644
--- a/testsuite/tests/ffi/should_run/ffi008.stderr
+++ b/testsuite/tests/ffi/should_run/ffi008.stderr
@@ -1,3 +1,9 @@
 ffi008: this is an error
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at ffi008.hs:12:12 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/ghc-api/T20757.stderr b/testsuite/tests/ghc-api/T20757.stderr
index 34678db7e35bb9e2218acc70075a4d34ec98e1fe..d709bc8a519af9f17d3e013a4e3cd2145c6e6b49 100644
--- a/testsuite/tests/ghc-api/T20757.stderr
+++ b/testsuite/tests/ghc-api/T20757.stderr
@@ -1 +1,5 @@
 T20757: could not detect mingw toolchain in the following paths: ["/..//mingw","/..//..//mingw","/..//..//..//mingw"]
+HasCallStack backtrace:
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:<line>:<column> in <package-id>:GHC.Internal.IO
+  throwIO, called at compiler/GHC/Utils/Panic.hs:<line>:<column> in <package-id>:GHC.Utils.Panic
diff --git a/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr b/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr
index 2f482aa5be1f3b7c9c6e7ff4a0e2376980cc69a0..733231c3bd68ba2c86f690a92dafbce5456f0cde 100644
--- a/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr
+++ b/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr
@@ -1,3 +1,10 @@
 <interactive>: unrecognised flag: -Xabcde
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.9-inplace:GHC.Utils.Error
+
+
+
 1
diff --git a/testsuite/tests/ghc-e/should_fail/T18441fail7.stderr b/testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
index aaf284760ad67c68af4693a7f80b5ce39b6d789d..aceb8bb25c2f5ac4ba4fbed5ec123a4d6fe83573 100644
--- a/testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
+++ b/testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
@@ -1,2 +1,9 @@
 <interactive>: IO error:  "Abcde" does not exist
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.9-inplace:GHC.Utils.Error
+
+
+
 1
diff --git a/testsuite/tests/ghc-e/should_fail/T18441fail8.stderr b/testsuite/tests/ghc-e/should_fail/T18441fail8.stderr
index 80b40ae5f598fe3d73e9e4d83dc13e419437bdce..9e9bf6f7178c591aadb9cbacce0773eb5d26a655 100644
--- a/testsuite/tests/ghc-e/should_fail/T18441fail8.stderr
+++ b/testsuite/tests/ghc-e/should_fail/T18441fail8.stderr
@@ -1,2 +1,9 @@
 <interactive>: syntax:  :script <filename>
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.9-inplace:GHC.Utils.Error
+
+
+
 1
diff --git a/testsuite/tests/ghc-e/should_fail/T23663.stderr b/testsuite/tests/ghc-e/should_fail/T23663.stderr
index 6180206af996a11e3daa22eec5e2b43252c4d594..c247d8fff8a20b125f2d76353ccda5271d9e3575 100644
--- a/testsuite/tests/ghc-e/should_fail/T23663.stderr
+++ b/testsuite/tests/ghc-e/should_fail/T23663.stderr
@@ -2,4 +2,11 @@
 did you mean one of:
   -XCUSKs
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.9-inplace:GHC.Utils.Error
+
+
+
 1
diff --git a/testsuite/tests/ghc-e/should_fail/T9930fail.stderr b/testsuite/tests/ghc-e/should_fail/T9930fail.stderr
index a76a467f89acb45126220bd6e082c87a66f4a870..bd137d75bcf1aefc60d083d7b489ad1fc57a6a5a 100644
--- a/testsuite/tests/ghc-e/should_fail/T9930fail.stderr
+++ b/testsuite/tests/ghc-e/should_fail/T9930fail.stderr
@@ -1,2 +1,11 @@
-ghc-stage2: default output name would overwrite the input file; must specify -o explicitly
+ghc: default output name would overwrite the input file; must specify -o explicitly
 Usage: For basic information, try the `--help' option.
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:860:84 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    onException, called at compiler/GHC/Driver/Make.hs:2974:23 in ghc-9.9-inplace:GHC.Driver.Make
+
+
+
diff --git a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
index 31194ee1a6bd6e0ca2e8a73532d6127157979923..58a0f5c2b10b459c1679188b4578df2e75ac23b1 100644
--- a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
+++ b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
@@ -1,3 +1,24 @@
 ghc-e005-prog: foo
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at ghc-e005.hs:12:10 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at compiler/GHC/Driver/Monad.hs:167:54 in ghc-9.9-inplace:GHC.Driver.Monad
+    a type signature in an instance, called at compiler/GHC/Driver/Monad.hs:167:54 in ghc-9.9-inplace:GHC.Driver.Monad
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at ghc/GHCi/UI/Monad.hs:288:15 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
+    a type signature in an instance, called at ghc/GHCi/UI/Monad.hs:288:15 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:490:21 in exceptions-0.10.7-inplace:Control.Monad.Catch
+    throwM, called at libraries/haskeline/System/Console/Haskeline/InputT.hs:53:39 in haskeline-0.8.2.1-inplace:System.Console.Haskeline.InputT
+    a type signature in an instance, called at libraries/haskeline/System/Console/Haskeline/InputT.hs:53:39 in haskeline-0.8.2.1-inplace:System.Console.Haskeline.InputT
+    throwM, called at ghc/GHCi/UI/Monad.hs:215:52 in ghc-bin-9.9.20240223-inplace:GHCi.UI.Monad
+
+
+
diff --git a/testsuite/tests/hpc/simple/tixs/T10529a.stderr b/testsuite/tests/hpc/simple/tixs/T10529a.stderr
index 2f495549f0f02e40937425f246da9c7f06d9f8ab..78f84f36db500d048609160b493b3a82e23ac2f5 100644
--- a/testsuite/tests/hpc/simple/tixs/T10529a.stderr
+++ b/testsuite/tests/hpc/simple/tixs/T10529a.stderr
@@ -1,3 +1,9 @@
 hpc: can not find NonExistingModule in ./.hpc
-CallStack (from ImplicitParams):
-  error, called at libraries/hpc/Trace/Hpc/Mix.hs:119:15 in hpc-0.6.0.2:Trace.Hpc.Mix
+CallStack (from HasCallStack):
+  error, called at libraries/hpc/Trace/Hpc/Mix.hs:110:15 in hpc-0.7.0.1-inplace:Trace.Hpc.Mix
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/hpc/simple/tixs/T10529b.stderr b/testsuite/tests/hpc/simple/tixs/T10529b.stderr
index ad9b6758439a3eb352bfba1cb811da80cd55bb7c..80e96b1800e0fd122e9bb2c5d3803c8f91a9d31e 100644
--- a/testsuite/tests/hpc/simple/tixs/T10529b.stderr
+++ b/testsuite/tests/hpc/simple/tixs/T10529b.stderr
@@ -1,4 +1,10 @@
 hpc: hash in tix file for module Main (1234567890)
 does not match hash in ./.hpc/Main.mix (2454134535)
-CallStack (from ImplicitParams):
-  error, called at libraries/hpc/Trace/Hpc/Mix.hs:129:17 in hpc-0.6.0.2:Trace.Hpc.Mix
+CallStack (from HasCallStack):
+  error, called at libraries/hpc/Trace/Hpc/Mix.hs:120:17 in hpc-0.7.0.1-inplace:Trace.Hpc.Mix
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/hpc/simple/tixs/T10529c.stderr b/testsuite/tests/hpc/simple/tixs/T10529c.stderr
index 0700886c856c2c5bb0c366c7f5865786ad713330..36a5e883ff0b1f0f8193bd1abf695d4feafe0ca3 100644
--- a/testsuite/tests/hpc/simple/tixs/T10529c.stderr
+++ b/testsuite/tests/hpc/simple/tixs/T10529c.stderr
@@ -1,3 +1,9 @@
 hpc: can not parse ./.hpc/NoParse.mix
-CallStack (from ImplicitParams):
-  error, called at libraries/hpc/Trace/Hpc/Mix.hs:103:43 in hpc-0.6.0.2:Trace.Hpc.Mix
+CallStack (from HasCallStack):
+  error, called at libraries/hpc/Trace/Hpc/Mix.hs:94:43 in hpc-0.7.0.1-inplace:Trace.Hpc.Mix
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index 94efbe6ce80022666b5880bae6a3b31f65a94ec3..38d10a4d96c6c2d2e92f49cfb8afdf760daf3760 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/testsuite/tests/interface-stability/base-exports.stdout
@@ -238,6 +238,7 @@ module Control.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type ExceptionWithContext :: * -> *
   data ExceptionWithContext a = ExceptionWithContext GHC.Internal.Exception.Context.ExceptionContext a
@@ -291,8 +292,8 @@ module Control.Exception where
   mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
   onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
   someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -309,6 +310,17 @@ module Control.Exception.Annotation where
   type SomeExceptionAnnotation :: *
   data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
 
+module Control.Exception.Backtrace where
+  -- Safety: None
+  type BacktraceMechanism :: *
+  data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
+  type Backtraces :: *
+  data Backtraces = ...
+  collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Types.IO Backtraces
+  displayBacktraces :: Backtraces -> GHC.Internal.Base.String
+  getBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.IO GHC.Types.Bool
+  setBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.Bool -> GHC.Types.IO ()
+
 module Control.Exception.Base where
   -- Safety: Safe
   type AllocationLimitExceeded :: *
@@ -337,6 +349,7 @@ module Control.Exception.Base where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type FixIOException :: *
   data FixIOException = FixIOException
@@ -394,8 +407,8 @@ module Control.Exception.Base where
   patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -5288,6 +5301,7 @@ module GHC.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -5304,7 +5318,7 @@ module GHC.Exception where
   prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
   ratioZeroDenomException :: SomeException
   showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
   underflowException :: SomeException
 
 module GHC.Exception.Type where
@@ -5316,6 +5330,7 @@ module GHC.Exception.Type where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -7499,7 +7514,7 @@ module GHC.IO where
   noDuplicate :: IO ()
   onException :: forall a b. IO a -> IO b -> IO a
   stToIO :: forall a. GHC.Internal.ST.ST GHC.Prim.RealWorld a -> IO a
-  throwIO :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> IO a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> IO a
   unIO :: forall a. IO a -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)
   uninterruptibleMask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
   uninterruptibleMask_ :: forall a. IO a -> IO a
@@ -7782,7 +7797,7 @@ module GHC.IO.Exception where
   cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
   heapOverflow :: GHC.Internal.Exception.Type.SomeException
   ioError :: forall a. IOError -> GHC.Types.IO a
-  ioException :: forall a. IOException -> GHC.Types.IO a
+  ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
   stackOverflow :: GHC.Internal.Exception.Type.SomeException
   unsupportedOperation :: IOError
   untangle :: GHC.Prim.Addr# -> GHC.Internal.Base.String -> GHC.Internal.Base.String
@@ -11674,6 +11689,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoSubSystem -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AssertionFailed -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11688,6 +11704,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.IOExcep
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Exception.Type.Exception a => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Exception.Type.Exception e => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
@@ -12306,6 +12323,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.IOException -- Defined
 instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Show.Show e => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.IO.MaskingState -- Defined in ‘GHC.Internal.IO’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
index 8f9f1045b389a089238250c3aae366426282e93b..1cec6c88aeac527fe4025d40bb55215bb967b2ca 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
@@ -238,6 +238,7 @@ module Control.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type ExceptionWithContext :: * -> *
   data ExceptionWithContext a = ExceptionWithContext GHC.Internal.Exception.Context.ExceptionContext a
@@ -291,8 +292,8 @@ module Control.Exception where
   mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
   onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
   someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -309,6 +310,17 @@ module Control.Exception.Annotation where
   type SomeExceptionAnnotation :: *
   data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
 
+module Control.Exception.Backtrace where
+  -- Safety: None
+  type BacktraceMechanism :: *
+  data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
+  type Backtraces :: *
+  data Backtraces = ...
+  collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Types.IO Backtraces
+  displayBacktraces :: Backtraces -> GHC.Internal.Base.String
+  getBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.IO GHC.Types.Bool
+  setBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.Bool -> GHC.Types.IO ()
+
 module Control.Exception.Base where
   -- Safety: Safe
   type AllocationLimitExceeded :: *
@@ -337,6 +349,7 @@ module Control.Exception.Base where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type FixIOException :: *
   data FixIOException = FixIOException
@@ -394,8 +407,8 @@ module Control.Exception.Base where
   patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -5257,6 +5270,7 @@ module GHC.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -5273,7 +5287,7 @@ module GHC.Exception where
   prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
   ratioZeroDenomException :: SomeException
   showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
   underflowException :: SomeException
 
 module GHC.Exception.Type where
@@ -5285,6 +5299,7 @@ module GHC.Exception.Type where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -7468,7 +7483,7 @@ module GHC.IO where
   noDuplicate :: IO ()
   onException :: forall a b. IO a -> IO b -> IO a
   stToIO :: forall a. GHC.Internal.ST.ST GHC.Prim.RealWorld a -> IO a
-  throwIO :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> IO a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> IO a
   unIO :: forall a. IO a -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)
   uninterruptibleMask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
   uninterruptibleMask_ :: forall a. IO a -> IO a
@@ -7751,7 +7766,7 @@ module GHC.IO.Exception where
   cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
   heapOverflow :: GHC.Internal.Exception.Type.SomeException
   ioError :: forall a. IOError -> GHC.Types.IO a
-  ioException :: forall a. IOException -> GHC.Types.IO a
+  ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
   stackOverflow :: GHC.Internal.Exception.Type.SomeException
   unsupportedOperation :: IOError
   untangle :: GHC.Prim.Addr# -> GHC.Internal.Base.String -> GHC.Internal.Base.String
@@ -14709,6 +14724,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoSubSystem -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AssertionFailed -- Defined in ‘GHC.Internal.IO.Exception’
@@ -14723,6 +14739,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.IOExcep
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Exception.Type.Exception a => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Exception.Type.Exception e => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
@@ -15343,6 +15360,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.IOException -- Defined
 instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Show.Show e => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.IO.MaskingState -- Defined in ‘GHC.Internal.IO’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index 8b71f57f2b8c75d1f63cafea1a669481b9457e33..36c1ee0ba2279465cc9969b2040e7359ec27e311 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
@@ -238,6 +238,7 @@ module Control.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type ExceptionWithContext :: * -> *
   data ExceptionWithContext a = ExceptionWithContext GHC.Internal.Exception.Context.ExceptionContext a
@@ -291,8 +292,8 @@ module Control.Exception where
   mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
   onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
   someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -309,6 +310,17 @@ module Control.Exception.Annotation where
   type SomeExceptionAnnotation :: *
   data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
 
+module Control.Exception.Backtrace where
+  -- Safety: None
+  type BacktraceMechanism :: *
+  data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
+  type Backtraces :: *
+  data Backtraces = ...
+  collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Types.IO Backtraces
+  displayBacktraces :: Backtraces -> GHC.Internal.Base.String
+  getBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.IO GHC.Types.Bool
+  setBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.Bool -> GHC.Types.IO ()
+
 module Control.Exception.Base where
   -- Safety: Safe
   type AllocationLimitExceeded :: *
@@ -337,6 +349,7 @@ module Control.Exception.Base where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type FixIOException :: *
   data FixIOException = FixIOException
@@ -394,8 +407,8 @@ module Control.Exception.Base where
   patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -5434,6 +5447,7 @@ module GHC.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -5450,7 +5464,7 @@ module GHC.Exception where
   prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
   ratioZeroDenomException :: SomeException
   showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
   underflowException :: SomeException
 
 module GHC.Exception.Type where
@@ -5462,6 +5476,7 @@ module GHC.Exception.Type where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -7648,7 +7663,7 @@ module GHC.IO where
   noDuplicate :: IO ()
   onException :: forall a b. IO a -> IO b -> IO a
   stToIO :: forall a. GHC.Internal.ST.ST GHC.Prim.RealWorld a -> IO a
-  throwIO :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> IO a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> IO a
   unIO :: forall a. IO a -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)
   uninterruptibleMask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
   uninterruptibleMask_ :: forall a. IO a -> IO a
@@ -7952,7 +7967,7 @@ module GHC.IO.Exception where
   cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
   heapOverflow :: GHC.Internal.Exception.Type.SomeException
   ioError :: forall a. IOError -> GHC.Types.IO a
-  ioException :: forall a. IOException -> GHC.Types.IO a
+  ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
   stackOverflow :: GHC.Internal.Exception.Type.SomeException
   unsupportedOperation :: IOError
   untangle :: GHC.Prim.Addr# -> GHC.Internal.Base.String -> GHC.Internal.Base.String
@@ -11939,6 +11954,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoSubSystem -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AssertionFailed -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11953,6 +11969,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.IOExcep
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Exception.Type.Exception a => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Exception.Type.Exception e => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
@@ -12584,6 +12601,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.IOException -- Defined
 instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Show.Show e => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.IO.MaskingState -- Defined in ‘GHC.Internal.IO’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index 94efbe6ce80022666b5880bae6a3b31f65a94ec3..38d10a4d96c6c2d2e92f49cfb8afdf760daf3760 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
@@ -238,6 +238,7 @@ module Control.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type ExceptionWithContext :: * -> *
   data ExceptionWithContext a = ExceptionWithContext GHC.Internal.Exception.Context.ExceptionContext a
@@ -291,8 +292,8 @@ module Control.Exception where
   mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
   onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
   someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -309,6 +310,17 @@ module Control.Exception.Annotation where
   type SomeExceptionAnnotation :: *
   data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
 
+module Control.Exception.Backtrace where
+  -- Safety: None
+  type BacktraceMechanism :: *
+  data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
+  type Backtraces :: *
+  data Backtraces = ...
+  collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Types.IO Backtraces
+  displayBacktraces :: Backtraces -> GHC.Internal.Base.String
+  getBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.IO GHC.Types.Bool
+  setBacktraceMechanismState :: BacktraceMechanism -> GHC.Types.Bool -> GHC.Types.IO ()
+
 module Control.Exception.Base where
   -- Safety: Safe
   type AllocationLimitExceeded :: *
@@ -337,6 +349,7 @@ module Control.Exception.Base where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type FixIOException :: *
   data FixIOException = FixIOException
@@ -394,8 +407,8 @@ module Control.Exception.Base where
   patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
   recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
-  throwIO :: forall e a. Exception e => e -> GHC.Types.IO a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
   throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
   try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
   tryJust :: forall e b a. Exception e => (e -> GHC.Internal.Maybe.Maybe b) -> GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either b a)
@@ -5288,6 +5301,7 @@ module GHC.Exception where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -5304,7 +5318,7 @@ module GHC.Exception where
   prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
   ratioZeroDenomException :: SomeException
   showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
-  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
+  throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
   underflowException :: SomeException
 
 module GHC.Exception.Type where
@@ -5316,6 +5330,7 @@ module GHC.Exception.Type where
     toException :: e -> SomeException
     fromException :: SomeException -> GHC.Internal.Maybe.Maybe e
     displayException :: e -> GHC.Internal.Base.String
+    backtraceDesired :: e -> GHC.Types.Bool
     {-# MINIMAL #-}
   type SomeException :: *
   data SomeException = forall e. (Exception e, GHC.Internal.Exception.Type.HasExceptionContext) => SomeException e
@@ -7499,7 +7514,7 @@ module GHC.IO where
   noDuplicate :: IO ()
   onException :: forall a b. IO a -> IO b -> IO a
   stToIO :: forall a. GHC.Internal.ST.ST GHC.Prim.RealWorld a -> IO a
-  throwIO :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> IO a
+  throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> IO a
   unIO :: forall a. IO a -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)
   uninterruptibleMask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
   uninterruptibleMask_ :: forall a. IO a -> IO a
@@ -7782,7 +7797,7 @@ module GHC.IO.Exception where
   cannotCompactPinned :: GHC.Internal.Exception.Type.SomeException
   heapOverflow :: GHC.Internal.Exception.Type.SomeException
   ioError :: forall a. IOError -> GHC.Types.IO a
-  ioException :: forall a. IOException -> GHC.Types.IO a
+  ioException :: forall a. GHC.Internal.Stack.Types.HasCallStack => IOException -> GHC.Types.IO a
   stackOverflow :: GHC.Internal.Exception.Type.SomeException
   unsupportedOperation :: IOError
   untangle :: GHC.Prim.Addr# -> GHC.Internal.Base.String -> GHC.Internal.Base.String
@@ -11674,6 +11689,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoHeapProfile -- Defined
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.DoTrace -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.GiveGCStats -- Defined in ‘GHC.Internal.RTS.Flags’
 instance GHC.Internal.Enum.Enum GHC.Internal.RTS.Flags.IoSubSystem -- Defined in ‘GHC.Internal.RTS.Flags’
+instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AssertionFailed -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11688,6 +11704,7 @@ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.IOExcep
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Exception.Type.Exception a => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Exception.Type.Exception e => GHC.Internal.Exception.Type.Exception (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Exception.Type.Exception GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
@@ -12306,6 +12323,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.IOException -- Defined
 instance GHC.Internal.Show.Show GHC.Internal.IO.Exception.SomeAsyncException -- Defined in ‘GHC.Internal.IO.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.ArithException -- Defined in ‘GHC.Internal.Exception.Type’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.ExceptionWithContext a) -- Defined in ‘GHC.Internal.Exception.Type’
+instance forall e. GHC.Internal.Show.Show e => GHC.Internal.Show.Show (GHC.Internal.Exception.Type.NoBacktrace e) -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.Type.SomeException -- Defined in ‘GHC.Internal.Exception.Type’
 instance GHC.Internal.Show.Show GHC.Internal.Exception.ErrorCall -- Defined in ‘GHC.Internal.Exception’
 instance GHC.Internal.Show.Show GHC.Internal.IO.MaskingState -- Defined in ‘GHC.Internal.IO’
diff --git a/testsuite/tests/mdo/should_fail/mdofail006.stderr b/testsuite/tests/mdo/should_fail/mdofail006.stderr
index e2cf503df735f2948bb63cdbf92376464448ef19..f870485c98531dd62bb3a2b3f9d2d9e9f40cf45e 100644
--- a/testsuite/tests/mdo/should_fail/mdofail006.stderr
+++ b/testsuite/tests/mdo/should_fail/mdofail006.stderr
@@ -1 +1,8 @@
 mdofail006: cyclic evaluation in fixIO
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at libraries/ghc-internal/src/GHC/Internal/System/IO.hs:426:37 in ghc-internal:GHC.Internal.System.IO
+
+
+
diff --git a/testsuite/tests/rebindable/RebindableFailA.stderr b/testsuite/tests/rebindable/RebindableFailA.stderr
index dfc52f42b05ba17ea45c02a8b7bd712a91355104..322ec2148d9c3cfa710a208ec517e912c915d4f8 100644
--- a/testsuite/tests/rebindable/RebindableFailA.stderr
+++ b/testsuite/tests/rebindable/RebindableFailA.stderr
@@ -1,3 +1,9 @@
 RebindableFailA: Failed with error
 CallStack (from HasCallStack):
   error, called at RebindableFailA.hs:10:10 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/runghc/T7859.stderr-mingw32 b/testsuite/tests/runghc/T7859.stderr-mingw32
index cc02c50d1b379a998172ad84efcd619aed2c6f5c..a47221128154dcbf3dcb16a643d36a7d543c2bb4 100644
--- a/testsuite/tests/runghc/T7859.stderr-mingw32
+++ b/testsuite/tests/runghc/T7859.stderr-mingw32
@@ -1 +1,6 @@
 runghc.exe: defer-type-errors: rawSystem: does not exist (No such file or directory)
+HasCallStack backtrace:
+  collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.Exception
+  toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:<line>:<column> in <package-id>:GHC.Internal.IO
+  throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
+  ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:<line>:<column> in <package-id>:GHC.Internal.IO.Exception
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
index 974af21631164ead1601626eb09373c455ae39ad..b52b55e0e74ce573598a324d70e0a6b12ada8aa3 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
@@ -1,3 +1,9 @@
 SafeLang09: This curry is poisoned!
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at ./SafeLang09_B.hs:14:13 in main:SafeLang09_B
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
index 9434e29c30c48b8bb439fdc5e6be776bda7b467c..9e976258cbaf7e2f8790b162c14dc22a4e3e1caa 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
@@ -1,2 +1,9 @@
 SafeLang15: SafeLang15.hs:22:9-37: Non-exhaustive patterns in Just p'
 
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/simplCore/should_fail/T7411.stderr b/testsuite/tests/simplCore/should_fail/T7411.stderr
index 9a72acaf2ccbb7b9dfe17cac969462730286af71..33b73375ee42f7aef083e01050a34a54bcb585d4 100644
--- a/testsuite/tests/simplCore/should_fail/T7411.stderr
+++ b/testsuite/tests/simplCore/should_fail/T7411.stderr
@@ -1,3 +1,9 @@
 T7411: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T7411.hs:3:25 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T16066.stderr b/testsuite/tests/simplCore/should_run/T16066.stderr
index 85cfbabec132b92d1bb1f2bea1e9f5bde79eb548..6814055938ce926fefb8084521c3dbbeffb9e6d3 100644
--- a/testsuite/tests/simplCore/should_run/T16066.stderr
+++ b/testsuite/tests/simplCore/should_run/T16066.stderr
@@ -1,3 +1,9 @@
 T16066: exit never happens
 CallStack (from HasCallStack):
-  error, called at T16066.hs:31:3 in main:Main
+  error, called at T16066.hs:27:3 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T16893/T16893.stderr b/testsuite/tests/simplCore/should_run/T16893/T16893.stderr
index c077f4bed148269324160819e674bb7ccb03ae0e..06c3b9ffb37327307fe17a83daf14b57cd79aaa0 100644
--- a/testsuite/tests/simplCore/should_run/T16893/T16893.stderr
+++ b/testsuite/tests/simplCore/should_run/T16893/T16893.stderr
@@ -1,3 +1,9 @@
 T16893: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at ./Complex.hs:47:28 in main:Complex
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T457.stderr b/testsuite/tests/simplCore/should_run/T457.stderr
index c84855e50048edbe3e19a16b509532082ec41de2..3700442f567ee846a9e6c1103008d18a5022c97c 100644
--- a/testsuite/tests/simplCore/should_run/T457.stderr
+++ b/testsuite/tests/simplCore/should_run/T457.stderr
@@ -1,3 +1,9 @@
 T457: Correct
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at T457.hs:5:22 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T5587.stderr b/testsuite/tests/simplCore/should_run/T5587.stderr
index 069d08d055f97d804e34a4d258351086bd4cfad2..f250cb2c9cb834232e4b71578ac0e3fecdf7cf6d 100644
--- a/testsuite/tests/simplCore/should_run/T5587.stderr
+++ b/testsuite/tests/simplCore/should_run/T5587.stderr
@@ -1,3 +1,9 @@
 T5587: hidden error
-CallStack (from ImplicitParams):
+CallStack (from HasCallStack):
   error, called at T5587.hs:7:15 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T5625.stderr b/testsuite/tests/simplCore/should_run/T5625.stderr
index a935ab7af8a11c39fd22bf23ce9d47f8a1ce4335..cc6c2f8332338f449ad0b3e7d0c707d0b790e5cf 100644
--- a/testsuite/tests/simplCore/should_run/T5625.stderr
+++ b/testsuite/tests/simplCore/should_run/T5625.stderr
@@ -1,3 +1,9 @@
 T5625: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T5625.hs:3:31 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/simplCore/should_run/T7924.stderr b/testsuite/tests/simplCore/should_run/T7924.stderr
index 8f269f7d1d6b1cf6217c115fab93761fe9bc541c..9efae82123360270089701a943f2c3b13813dcfb 100644
--- a/testsuite/tests/simplCore/should_run/T7924.stderr
+++ b/testsuite/tests/simplCore/should_run/T7924.stderr
@@ -1 +1,8 @@
 T7924: Boom
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
+    throwIO, called at T7924.hs:14:30 in main:Main
+
+
+
diff --git a/testsuite/tests/type-data/should_run/T22332a.stderr b/testsuite/tests/type-data/should_run/T22332a.stderr
index 693ad699868a4ecb6f74883a464683af3fceb765..64a76e77471bdeefc7e8100cc33579ef9f376481 100644
--- a/testsuite/tests/type-data/should_run/T22332a.stderr
+++ b/testsuite/tests/type-data/should_run/T22332a.stderr
@@ -1 +1,9 @@
 T22332a: T22332a.hs:18:1-35: Non-exhaustive patterns in Just eq
+
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:422:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/typecheck/should_compile/T17343.stderr b/testsuite/tests/typecheck/should_compile/T17343.stderr
index db8aa1c74ae9b235c60a378b80fd1ce0641bba58..4899b8ad06930fa533e4631a943dbf4c8b4ba47e 100644
--- a/testsuite/tests/typecheck/should_compile/T17343.stderr
+++ b/testsuite/tests/typecheck/should_compile/T17343.stderr
@@ -1,3 +1,9 @@
 T17343: Prelude.undefined
 CallStack (from HasCallStack):
   undefined, called at T17343.hs:4:11 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T10284.stderr b/testsuite/tests/typecheck/should_run/T10284.stderr
index 55f5731d61c7b6a72445a9e3387e254722bea486..07612591ac34b8aac5fd00da8ff81ce239ff72a6 100644
--- a/testsuite/tests/typecheck/should_run/T10284.stderr
+++ b/testsuite/tests/typecheck/should_run/T10284.stderr
@@ -1,5 +1,12 @@
-T10284.exe: T10284.hs:7:5: error: [GHC-83865]
+T10284: T10284.hs:7:5: error: [GHC-83865]
     • Couldn't match expected type ‘Int’ with actual type ‘Char’
     • In the expression: 'a'
       In an equation for ‘a’: a = 'a'
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T11049.stderr b/testsuite/tests/typecheck/should_run/T11049.stderr
index ed264c6174232b574f6d7219bddd4d54c1fff501..53f2a5f22fa0c8176c7aab2ce07bd04c36fdbf8a 100644
--- a/testsuite/tests/typecheck/should_run/T11049.stderr
+++ b/testsuite/tests/typecheck/should_run/T11049.stderr
@@ -1 +1,7 @@
 T11049: look ma, no stack!
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T11715.stderr b/testsuite/tests/typecheck/should_run/T11715.stderr
index ef267fa85fcbf1a5760ed4e3f0c921fefca0b6e8..276a71ce44e6d6f1b3709dc7eec85c1abb6a2d68 100644
--- a/testsuite/tests/typecheck/should_run/T11715.stderr
+++ b/testsuite/tests/typecheck/should_run/T11715.stderr
@@ -1,3 +1,9 @@
 T11715: No more bug!
 CallStack (from HasCallStack):
   error, called at T11715.hs:8:31 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T13838.stderr b/testsuite/tests/typecheck/should_run/T13838.stderr
index 39eacdc67b230ed4cee418027a9f8180e58b49bc..58484b3598d44b8f8bf61c3e43d8f9b1acccc128 100644
--- a/testsuite/tests/typecheck/should_run/T13838.stderr
+++ b/testsuite/tests/typecheck/should_run/T13838.stderr
@@ -1,7 +1,14 @@
-T13838.exe: T13838.hs:6:1: error: [GHC-83865]
+T13838: T13838.hs:6:1: error: [GHC-83865]
     • Couldn't match expected type: IO t0
                   with actual type: () -> ()
     • Probable cause: ‘main’ is applied to too few arguments
       In the expression: main
       When checking the type of the IO action ‘main’
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T21973a.stderr b/testsuite/tests/typecheck/should_run/T21973a.stderr
index d24d5db484d9865713b84a70712870a597b78aac..7009175543b703d40a3472c70b53eaa864ee8859 100644
--- a/testsuite/tests/typecheck/should_run/T21973a.stderr
+++ b/testsuite/tests/typecheck/should_run/T21973a.stderr
@@ -1,3 +1,9 @@
 T21973a: True
 CallStack (from HasCallStack):
   error, called at T21973a.hs:42:23 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T9497a-run.stderr b/testsuite/tests/typecheck/should_run/T9497a-run.stderr
index b33beac5b585cf32523668342d38bb8079fb3743..cde8045fe6ae6229366996733899db1038e88afd 100644
--- a/testsuite/tests/typecheck/should_run/T9497a-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497a-run.stderr
@@ -15,3 +15,10 @@ T9497a-run: T9497a-run.hs:2:8: error: [GHC-88464]
           (imported from ‘Prelude’ at T9497a-run.hs:1:1
            (and originally defined in ‘GHC.Internal.Base’))
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T9497b-run.stderr b/testsuite/tests/typecheck/should_run/T9497b-run.stderr
index a8f8a2b1490ba0b3e50a705d7274284bcdf6ae4a..dea530f38c1695152aceee8f3e2ced50438c63f1 100644
--- a/testsuite/tests/typecheck/should_run/T9497b-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497b-run.stderr
@@ -15,3 +15,10 @@ T9497b-run: T9497b-run.hs:2:8: error: [GHC-88464]
           (imported from ‘Prelude’ at T9497b-run.hs:1:1
            (and originally defined in ‘GHC.Internal.Base’))
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/T9497c-run.stderr b/testsuite/tests/typecheck/should_run/T9497c-run.stderr
index fb2ccf0581e098acce56e0b9b33d50f45da1d7c2..9355fa6e9054f5a500669b920db8b7eaffd75fea 100644
--- a/testsuite/tests/typecheck/should_run/T9497c-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497c-run.stderr
@@ -15,3 +15,10 @@ T9497c-run: T9497c-run.hs:2:8: error: [GHC-88464]
           (imported from ‘Prelude’ at T9497c-run.hs:1:1
            (and originally defined in ‘GHC.Internal.Base’))
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/unlifted-datatypes/should_run/UnlGadt1.stderr b/testsuite/tests/unlifted-datatypes/should_run/UnlGadt1.stderr
index 158e2a12ba907cfbdec0f9a466d7e44d0ded4461..43874a67b47bf6526e142e429d0c0e4691e7130c 100644
--- a/testsuite/tests/unlifted-datatypes/should_run/UnlGadt1.stderr
+++ b/testsuite/tests/unlifted-datatypes/should_run/UnlGadt1.stderr
@@ -1,3 +1,9 @@
 UnlGadt1: boom
 CallStack (from HasCallStack):
-  error, called at UnlGadt1.hs:19:13 in main:Main
+  error, called at UnlGadt1.hs:20:13 in main:Main
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:128:3 in ghc-internal:GHC.Internal.Exception
+
+
+
diff --git a/testsuite/tests/unsatisfiable/T23816.stderr b/testsuite/tests/unsatisfiable/T23816.stderr
index 0bad829d1d810f73f6e6faec3deea57aa5936013..5cd78fa23f6071614150cdaad1a3d98c1885f017 100644
--- a/testsuite/tests/unsatisfiable/T23816.stderr
+++ b/testsuite/tests/unsatisfiable/T23816.stderr
@@ -1,6 +1,13 @@
-T23816.exe: T23816.hs:18:15: error: [GHC-22250]
+T23816: T23816.hs:18:15: error: [GHC-22250]
     • Msg
     • In the first argument of ‘print’, namely ‘(meth1 'x')’
       In the expression: print (meth1 'x')
       In an equation for ‘main’: main = print (meth1 'x')
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+
diff --git a/testsuite/tests/unsatisfiable/UnsatDefer.stderr b/testsuite/tests/unsatisfiable/UnsatDefer.stderr
index fa802c3b3dc21e2a18c0492b69dbafdf9f57f58c..0b4c2ea546d96c36b466b245409f8eb98d38aac1 100644
--- a/testsuite/tests/unsatisfiable/UnsatDefer.stderr
+++ b/testsuite/tests/unsatisfiable/UnsatDefer.stderr
@@ -1,5 +1,12 @@
-UnsatDefer.exe: UnsatDefer.hs:20:7: error: [GHC-22250]
+UnsatDefer: UnsatDefer.hs:20:7: error: [GHC-22250]
     • Equality is not reflexive on Double
     • In the expression: reflexiveEq 0 (0 :: Double)
       In an equation for ‘foo’: foo = reflexiveEq 0 (0 :: Double)
 (deferred type error)
+HasCallStack backtrace:
+    collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+    toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
+    throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:423:30 in ghc-internal:GHC.Internal.Control.Exception.Base
+
+
+