diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 6f7b07ef0c5f376196fa680841eb0f0e2a06046b..dc02efb46f0057e99167f59c7ce2f86803754fb5 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -34,6 +34,7 @@
   * Move `Lift ByteArray` and `Lift Fixed` instances into `base` from `template-haskell`. See [CLC proposal #287](https://github.com/haskell/core-libraries-committee/issues/287).
   * Modify the implementation of `Control.Exception.throw` to avoid call-sites being inferred as diverging via precise exception.
     ([GHC #25066](https://gitlab.haskell.org/ghc/ghc/-/issues/25066), [CLC proposal #290](https://github.com/haskell/core-libraries-committee/issues/290))
+  * Make `Debug.Trace.{traceEventIO,traceMarkerIO}` faster when tracing is disabled. See [CLC proposal #291](https://github.com/haskell/core-libraries-committee/issues/291).
 
 ## 4.20.0.0 May 2024
   * Shipped with GHC 9.10.1
diff --git a/libraries/ghc-internal/ghc-internal.cabal.in b/libraries/ghc-internal/ghc-internal.cabal.in
index fb6cc89aa25c355777c4cb0f9619d01ae5feebbb..78c922becf06b33234d8344626e6019bdb53d6f1 100644
--- a/libraries/ghc-internal/ghc-internal.cabal.in
+++ b/libraries/ghc-internal/ghc-internal.cabal.in
@@ -253,6 +253,7 @@ Library
         GHC.Internal.Records
         GHC.Internal.ResponseFile
         GHC.Internal.RTS.Flags
+        GHC.Internal.RTS.Flags.Test
         GHC.Internal.ST
         GHC.Internal.Stack.CloneStack
         GHC.Internal.StaticPtr
diff --git a/libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs b/libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
index 47fe8f2edfc939962c9ae70b119e805085a70f4a..400d6d5ebe02b81aaaf9011af4d06aa6e56eceb9 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE Unsafe #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE UnboxedTuples #-}
@@ -54,6 +55,11 @@ import GHC.Internal.Ptr
 import GHC.Internal.Show
 import GHC.Internal.Stack
 import GHC.Internal.Data.List (null, partition)
+import GHC.Internal.RTS.Flags.Test
+
+-- | 'userEventTracingEnabled' is True if event logging for user events (@+RTS -l@) is enabled.
+userEventTracingEnabled :: IO Bool
+userEventTracingEnabled = getUserEventTracingEnabled
 
 -- | The 'traceIO' function outputs the trace message from the IO monad.
 -- This sequences the output with respect to other IO actions.
@@ -239,8 +245,8 @@ traceStack str expr = unsafePerformIO $ do
 
 {-# NOINLINE traceEvent #-}
 -- | The 'traceEvent' function behaves like 'trace' with the difference that
--- the message is emitted to the eventlog, if eventlog profiling is available
--- and enabled at runtime.
+-- the message is emitted to the eventlog, if eventlog tracing is available
+-- and user event tracing is enabled at runtime.
 --
 -- It is suitable for use in pure code. In an IO context use 'traceEventIO'
 -- instead.
@@ -256,16 +262,19 @@ traceEvent msg expr = unsafeDupablePerformIO $ do
     return expr
 
 -- | The 'traceEventIO' function emits a message to the eventlog, if eventlog
--- profiling is available and enabled at runtime.
+-- tracing is available and user event tracing is enabled at runtime.
 --
 -- Compared to 'traceEvent', 'traceEventIO' sequences the event with respect to
 -- other IO actions.
 --
 -- @since base-4.5.0.0
 traceEventIO :: String -> IO ()
-traceEventIO msg =
-  Enc.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
-    case traceEvent# p s of s' -> (# s', () #)
+{-# INLINE traceEventIO #-}
+traceEventIO msg = do
+  enabled <- userEventTracingEnabled
+  when enabled $
+    Enc.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+      case traceEvent# p s of s' -> (# s', () #)
 
 -- | Like 'traceEvent', but emits the result of calling a function on its
 -- argument.
@@ -276,7 +285,7 @@ traceEventWith f a = traceEvent (f a) a
 
 {-# NOINLINE traceMarker #-}
 -- | The 'traceMarker' function emits a marker to the eventlog, if eventlog
--- profiling is available and enabled at runtime. The @String@ is the name of
+-- tracing is available and enabled at runtime. The @String@ is the name of
 -- the marker. The name is just used in the profiling tools to help you keep
 -- clear which marker is which.
 --
@@ -294,16 +303,19 @@ traceMarker msg expr = unsafeDupablePerformIO $ do
     return expr
 
 -- | The 'traceMarkerIO' function emits a marker to the eventlog, if eventlog
--- profiling is available and enabled at runtime.
+-- tracing is available and user event tracing is enabled at runtime.
 --
 -- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to
 -- other IO actions.
 --
 -- @since base-4.7.0.0
 traceMarkerIO :: String -> IO ()
-traceMarkerIO msg =
-  Enc.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
-    case traceMarker# p s of s' -> (# s', () #)
+{-# INLINE traceMarkerIO #-}
+traceMarkerIO msg = do
+  enabled <- userEventTracingEnabled
+  when enabled $
+    Enc.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+      case traceMarker# p s of s' -> (# s', () #)
 
 -- | Immediately flush the event log, if enabled.
 --
diff --git a/libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc b/libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
index bb22da7fcee148d3314cabfbb9c42be06a13a333..595217fbb12b63f2460674be5fdd02399bcb31dd 100644
--- a/libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
+++ b/libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
@@ -613,6 +613,10 @@ getProfFlags = do
 
 getTraceFlags :: IO TraceFlags
 getTraceFlags = do
+#if defined(javascript_HOST_ARCH)
+  -- The JS backend does not currently have trace flags
+  pure (TraceFlags TraceNone False False False False False False False)
+#else
   let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
   TraceFlags <$> (toEnum . fromIntegral
                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
@@ -630,6 +634,7 @@ getTraceFlags = do
                    (#{peek TRACE_FLAGS, sparks_full} ptr :: IO CBool))
              <*> (toBool <$>
                    (#{peek TRACE_FLAGS, user} ptr :: IO CBool))
+#endif
 
 getTickyFlags :: IO TickyFlags
 getTickyFlags = do
diff --git a/libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc b/libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..3312d7737e29d72dbaeef4a9a4f708ce8b8d3c53
--- /dev/null
+++ b/libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
@@ -0,0 +1,36 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Module with fewer dependencies than GHC.Internal.RTS.Flags
+-- that allows to quickly test if some flag is set.
+module GHC.Internal.RTS.Flags.Test
+  ( getUserEventTracingEnabled
+  )
+where
+
+import GHC.Internal.Base
+
+#if !defined(javascript_HOST_ARCH)
+
+import GHC.Internal.Ptr
+import GHC.Internal.Foreign.C.Types
+import GHC.Internal.Foreign.Marshal.Utils
+import GHC.Internal.Foreign.Storable
+import GHC.Internal.Data.Functor ((<$>))
+
+#include "Rts.h"
+#include "rts/Flags.h"
+
+foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr ()
+#endif
+
+-- | Specialized version of 'getTraceFlags' for just checking if user
+-- event tracing is enabled.
+getUserEventTracingEnabled :: IO Bool
+getUserEventTracingEnabled = do
+#if defined(javascript_HOST_ARCH)
+  -- The JS backend does not currently have trace flags
+  pure False
+#else
+  let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr
+  toBool <$> (#{peek TRACE_FLAGS, user} ptr :: IO CBool)
+#endif
diff --git a/testsuite/tests/perf/should_run/T17949.hs b/testsuite/tests/perf/should_run/T17949.hs
new file mode 100644
index 0000000000000000000000000000000000000000..6d7310d6fc498140f8566b6030600fb8e2e1c7ef
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T17949.hs
@@ -0,0 +1,7 @@
+module Main where
+
+import Debug.Trace
+
+main :: IO ()
+main = do
+  traceEventIO (show [0..1234567])
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 2c069bb9260ebcceeb8997b8f9a4e4427ab8b1db..e27863b5654066ba28cb7ac74f2f1a880f53bc80 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -414,3 +414,4 @@ test('T21839r',
 test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O'])
 test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2'])
 test('T25055', [collect_stats('bytes allocated', 2), only_ways(['normal'])], compile_and_run, ['-O2'])
+test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2'])
diff --git a/testsuite/tests/profiling/should_run/callstack002.stderr b/testsuite/tests/profiling/should_run/callstack002.stderr
index 07ee98d73061986411b4bea2fc07472fdddca746..667533010afd0256820540f706e4c745b4eac339 100644
--- a/testsuite/tests/profiling/should_run/callstack002.stderr
+++ b/testsuite/tests/profiling/should_run/callstack002.stderr
@@ -1,6 +1,6 @@
 f: 42
 CallStack (from -prof):
-  GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:234:1-10)
+  GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:240:1-10)
   Main.f (callstack002.hs:10:7-43)
   Main.map.go (callstack002.hs:15:21-23)
   Main.map.go (callstack002.hs:15:21-34)
@@ -9,7 +9,7 @@ CallStack (from -prof):
   Main.CAF (<entire-module>)
 f: 43
 CallStack (from -prof):
-  GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:234:1-10)
+  GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:240:1-10)
   Main.f (callstack002.hs:10:7-43)
   Main.map.go (callstack002.hs:15:21-23)
   Main.map.go (callstack002.hs:15:21-34)