Remove unsafeGlobalDynFlags (#17957, #14597)

There are still global variables but only 3 booleans instead of a single
DynFlags.

compiler/GHC/Core/Unfold.hs

@@ -1156,7 +1156,8 @@ tryUnfolding dflags id lone_variable
              , extra_doc
              , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]
 
-    str = "Considering inlining: " ++ showSDocDump dflags (ppr id)
+    ctx = initSDocContext dflags defaultDumpStyle
+    str = "Considering inlining: " ++ showSDocDump ctx (ppr id)
     n_val_args = length arg_infos
 
            -- some_benefit is used when the RHS is small enough

compiler/GHC/Driver/Ppr.hs

@@ -29,6 +29,7 @@ import GHC.Utils.Exception
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.GlobalVars
 import GHC.Utils.Ppr       ( Mode(..) )
 import {-# SOURCE #-} GHC.Unit.State
 
@@ -43,7 +44,7 @@ showPpr :: Outputable a => DynFlags -> a -> String
 showPpr dflags thing = showSDoc dflags (ppr thing)
 
 showPprUnsafe :: Outputable a => a -> String
-showPprUnsafe a = showPpr unsafeGlobalDynFlags a
+showPprUnsafe a = renderWithContext defaultSDocContext (ppr a)
 
 -- | Allows caller to specify the PrintUnqualified to use
 showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
@@ -53,8 +54,8 @@ showSDocForUser dflags unqual doc = renderWithContext (initSDocContext dflags st
       unit_state = unitState dflags
       doc'       = pprWithUnitState unit_state doc
 
-showSDocDump :: DynFlags -> SDoc -> String
-showSDocDump dflags d = renderWithContext (initSDocContext dflags defaultDumpStyle) d
+showSDocDump :: SDocContext -> SDoc -> String
+showSDocDump ctx d = renderWithContext ctx (withPprStyle defaultDumpStyle d)
 
 showSDocDebug :: DynFlags -> SDoc -> String
 showSDocDebug dflags d = renderWithContext ctx d
@@ -75,9 +76,9 @@ printForC dflags handle doc =
   printSDocLn ctx LeftMode handle doc
   where ctx = initSDocContext dflags (PprCode CStyle)
 
-pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a
-pprDebugAndThen dflags cont heading pretty_msg
- = cont (showSDocDump dflags doc)
+pprDebugAndThen :: SDocContext -> (String -> a) -> SDoc -> SDoc -> a
+pprDebugAndThen ctx cont heading pretty_msg
+ = cont (showSDocDump ctx doc)
  where
      doc = sep [heading, nest 2 pretty_msg]
 
@@ -85,19 +86,22 @@ pprDebugAndThen dflags cont heading pretty_msg
 pprTraceWithFlags :: DynFlags -> String -> SDoc -> a -> a
 pprTraceWithFlags dflags str doc x
   | hasNoDebugOutput dflags = x
-  | otherwise               = pprDebugAndThen dflags trace (text str) doc x
+  | otherwise               = pprDebugAndThen (initSDocContext dflags defaultDumpStyle)
+                                              trace (text str) doc x
 
 -- | If debug output is on, show some 'SDoc' on the screen
 pprTrace :: String -> SDoc -> a -> a
-pprTrace str doc x = pprTraceWithFlags unsafeGlobalDynFlags str doc x
+pprTrace str doc x
+  | unsafeHasNoDebugOutput = x
+  | otherwise              = pprDebugAndThen defaultSDocContext trace (text str) doc x
 
 pprTraceM :: Applicative f => String -> SDoc -> f ()
 pprTraceM str doc = pprTrace str doc (pure ())
 
 pprTraceDebug :: String -> SDoc -> a -> a
 pprTraceDebug str doc x
-   | debugIsOn && hasPprDebug unsafeGlobalDynFlags = pprTrace str doc x
-   | otherwise                                     = x
+   | debugIsOn && unsafeHasPprDebug = pprTrace str doc x
+   | otherwise                      = x
 
 -- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x@.
 -- This allows you to print details from the returned value as well as from
@@ -114,7 +118,7 @@ pprTraceIt desc x = pprTraceWith desc ppr x
 pprTraceException :: ExceptionMonad m => String -> SDoc -> m a -> m a
 pprTraceException heading doc =
     handleGhcException $ \exc -> liftIO $ do
-        putStrLn $ showSDocDump unsafeGlobalDynFlags (sep [text heading, nest 2 doc])
+        putStrLn $ showSDocDump defaultSDocContext (sep [text heading, nest 2 doc])
         throwGhcExceptionIO exc
 
 -- | If debug output is on, show some 'SDoc' on the screen along
@@ -127,10 +131,10 @@ warnPprTrace :: HasCallStack => Bool -> String -> Int -> SDoc -> a -> a
 -- Should typically be accessed with the WARN macros
 warnPprTrace _     _     _     _    x | not debugIsOn     = x
 warnPprTrace _     _file _line _msg x
-   | hasNoDebugOutput unsafeGlobalDynFlags = x
+   | unsafeHasNoDebugOutput = x
 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
-  = pprDebugAndThen unsafeGlobalDynFlags trace heading
+  = pprDebugAndThen defaultSDocContext trace heading
                     (msg $$ callStackDoc )
                     x
   where

compiler/GHC/Driver/Session.hs

@@ -15,8 +15,6 @@
 --
 -------------------------------------------------------------------------------
 
-{-# OPTIONS_GHC -fno-cse #-}
--- -fno-cse is needed for GLOBAL_VAR's to behave properly
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module GHC.Driver.Session (
@@ -199,7 +197,7 @@ module GHC.Driver.Session (
 
         wordAlignment,
 
-        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
+        setUnsafeGlobalDynFlags,
 
         -- * SSE and AVX
         isSseEnabled,
@@ -256,6 +254,7 @@ import GHC.Settings.Constants
 import GHC.Utils.Panic
 import qualified GHC.Utils.Ppr.Colour as Col
 import GHC.Utils.Misc
+import GHC.Utils.GlobalVars
 import GHC.Data.Maybe
 import GHC.Utils.Monad
 import qualified GHC.Utils.Ppr as Pretty
@@ -275,7 +274,6 @@ import GHC.Utils.Json
 import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
 import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
 
-import System.IO.Unsafe ( unsafePerformIO )
 import Data.IORef
 import Control.Arrow ((&&&))
 import Control.Monad
@@ -305,11 +303,6 @@ import qualified GHC.Data.EnumSet as EnumSet
 import GHC.Foreign (withCString, peekCString)
 import qualified GHC.LanguageExtensions as LangExt
 
-#if GHC_STAGE >= 2
--- used by SHARED_GLOBAL_VAR
-import Foreign (Ptr)
-#endif
-
 -- Note [Updating flag description in the User's Guide]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -4892,40 +4885,12 @@ makeDynFlagsConsistent dflags
           os   = platformOS   platform
 
 
---------------------------------------------------------------------------
--- Do not use unsafeGlobalDynFlags!
---
--- unsafeGlobalDynFlags is a hack, necessary because we need to be able
--- to show SDocs when tracing, but we don't always have DynFlags
--- available.
---
--- Do not use it if you can help it. You may get the wrong value, or this
--- panic!
-
--- | This is the value that 'unsafeGlobalDynFlags' takes before it is
--- initialized.
-defaultGlobalDynFlags :: DynFlags
-defaultGlobalDynFlags =
-    (defaultDynFlags settings llvmConfig) { verbosity = 2 }
-  where
-    settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
-    llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
-
-#if GHC_STAGE < 2
-GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
-#else
-SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags
-                 , getOrSetLibHSghcGlobalDynFlags
-                 , "getOrSetLibHSghcGlobalDynFlags"
-                 , defaultGlobalDynFlags
-                 , DynFlags )
-#endif
-
-unsafeGlobalDynFlags :: DynFlags
-unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
-
 setUnsafeGlobalDynFlags :: DynFlags -> IO ()
-setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
+setUnsafeGlobalDynFlags dflags = do
+   writeIORef v_unsafeHasPprDebug (hasPprDebug dflags)
+   writeIORef v_unsafeHasNoDebugOutput (hasNoDebugOutput dflags)
+   writeIORef v_unsafeHasNoStateHack (hasNoStateHack dflags)
+
 
 -- -----------------------------------------------------------------------------
 -- SSE and AVX

compiler/GHC/Driver/Session.hs-boot

@@ -9,7 +9,6 @@ data DynFlags
 
 targetPlatform           :: DynFlags -> Platform
 unitState                :: DynFlags -> UnitState
-unsafeGlobalDynFlags     :: DynFlags
 hasPprDebug              :: DynFlags -> Bool
 hasNoDebugOutput         :: DynFlags -> Bool
 initSDocContext          :: DynFlags -> PprStyle -> SDocContext

compiler/GHC/StgToCmm/Bind.hs

@@ -755,14 +755,15 @@ link_caf node = do
 -- name of the data constructor itself.  Otherwise it is determined by
 -- @closureDescription@ from the let binding information.
 
-closureDescription :: DynFlags
-           -> Module            -- Module
-                   -> Name              -- Id of closure binding
-                   -> String
+closureDescription
+   :: DynFlags
+   -> Module            -- Module
+   -> Name              -- Id of closure binding
+   -> String
         -- Not called for StgRhsCon which have global info tables built in
         -- CgConTbls.hs with a description generated from the data constructor
 closureDescription dflags mod_name name
-  = showSDocDump dflags (char '<' <>
+  = showSDocDump (initSDocContext dflags defaultDumpStyle) (char '<' <>
                     (if isExternalName name
                       then ppr name -- ppr will include the module name prefix
                       else pprModule mod_name <> char '.' <> ppr name) <>

compiler/GHC/Types/Id.hs

@@ -123,7 +123,6 @@ module GHC.Types.Id (
 
 import GHC.Prelude
 
-import GHC.Driver.Session
 import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
                  isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
 
@@ -161,6 +160,7 @@ import GHC.Core.Multiplicity
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.GlobalVars
 
 import GHC.Driver.Ppr
 
@@ -843,7 +843,7 @@ typeOneShot ty
 
 isStateHackType :: Type -> Bool
 isStateHackType ty
-  | hasNoStateHack unsafeGlobalDynFlags
+  | unsafeHasNoStateHack
   = False
   | otherwise
   = case tyConAppTyCon_maybe ty of

compiler/GHC/Utils/Error.hs

@@ -820,13 +820,15 @@ prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a
 prettyPrintGhcErrors dflags
     = MC.handle $ \e -> case e of
                       PprPanic str doc ->
-                          pprDebugAndThen dflags panic (text str) doc
+                          pprDebugAndThen ctx panic (text str) doc
                       PprSorry str doc ->
-                          pprDebugAndThen dflags sorry (text str) doc
+                          pprDebugAndThen ctx sorry (text str) doc
                       PprProgramError str doc ->
-                          pprDebugAndThen dflags pgmError (text str) doc
+                          pprDebugAndThen ctx pgmError (text str) doc
                       _ ->
                           liftIO $ throwIO e
+      where
+         ctx = initSDocContext dflags defaultUserStyle
 
 -- | Checks if given 'WarnMsg' is a fatal warning.
 isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)

compiler/GHC/Utils/GlobalVars.hs

+{-# LANGUAGE CPP #-}
+
+{-# OPTIONS_GHC -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
+module GHC.Utils.GlobalVars
+   ( v_unsafeHasPprDebug
+   , v_unsafeHasNoDebugOutput
+   , v_unsafeHasNoStateHack
+   , unsafeHasPprDebug
+   , unsafeHasNoDebugOutput
+   , unsafeHasNoStateHack
+
+   , global
+   , consIORef
+   , globalM
+   , sharedGlobal
+   , sharedGlobalM
+   )
+where
+
+#include "HsVersions.h"
+
+import GHC.Prelude
+
+import GHC.Conc.Sync ( sharedCAF )
+
+import System.IO.Unsafe
+import Data.IORef
+import Foreign (Ptr)
+
+
+--------------------------------------------------------------------------
+-- Do not use global variables!
+--
+-- Global variables are a hack. Do not use them if you can help it.
+
+#if GHC_STAGE < 2
+
+GLOBAL_VAR(v_unsafeHasPprDebug,      False, Bool)
+GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool)
+GLOBAL_VAR(v_unsafeHasNoStateHack,   False, Bool)
+
+#else
+SHARED_GLOBAL_VAR( v_unsafeHasPprDebug
+                 , getOrSetLibHSghcGlobalHasPprDebug
+                 , "getOrSetLibHSghcGlobalHasPprDebug"
+                 , False
+                 , Bool )
+SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput
+                 , getOrSetLibHSghcGlobalHasNoDebugOutput
+                 , "getOrSetLibHSghcGlobalHasNoDebugOutput"
+                 , False
+                 , Bool )
+SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack
+                 , getOrSetLibHSghcGlobalHasNoStateHack
+                 , "getOrSetLibHSghcGlobalHasNoStateHack"
+                 , False
+                 , Bool )
+#endif
+
+unsafeHasPprDebug :: Bool
+unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug
+
+unsafeHasNoDebugOutput :: Bool
+unsafeHasNoDebugOutput = unsafePerformIO $ readIORef v_unsafeHasNoDebugOutput
+
+unsafeHasNoStateHack :: Bool
+unsafeHasNoStateHack = unsafePerformIO $ readIORef v_unsafeHasNoStateHack
+
+{-
+************************************************************************
+*                                                                      *
+                        Globals and the RTS
+*                                                                      *
+************************************************************************
+
+When a plugin is loaded, it currently gets linked against a *newly
+loaded* copy of the GHC package. This would not be a problem, except
+that the new copy has its own mutable state that is not shared with
+that state that has already been initialized by the original GHC
+package.
+
+(Note that if the GHC executable was dynamically linked this
+wouldn't be a problem, because we could share the GHC library it
+links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
+
+The solution is to make use of @sharedCAF@ through @sharedGlobal@
+for globals that are shared between multiple copies of ghc packages.
+-}
+
+-- Global variables:
+
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+
+consIORef :: IORef [a] -> a -> IO ()
+consIORef var x = do
+  atomicModifyIORef' var (\xs -> (x:xs,()))
+
+globalM :: IO a -> IORef a
+globalM ma = unsafePerformIO (ma >>= newIORef)
+
+-- Shared global variables:
+
+sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
+sharedGlobal a get_or_set = unsafePerformIO $
+  newIORef a >>= flip sharedCAF get_or_set
+
+sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
+sharedGlobalM ma get_or_set = unsafePerformIO $
+  ma >>= newIORef >>= flip sharedCAF get_or_set

compiler/GHC/Utils/Misc.hs

@@ -107,9 +107,6 @@ module GHC.Utils.Misc (
         modificationTimeIfExists,
         withAtomicRename,
 
-        global, consIORef, globalM,
-        sharedGlobal, sharedGlobalM,
-
         -- * Filenames and paths
         Suffix,
         splitLongestPrefix,
@@ -143,8 +140,6 @@ import GHC.Utils.Exception
 import GHC.Utils.Panic.Plain
 
 import Data.Data
-import Data.IORef       ( IORef, newIORef, atomicModifyIORef' )
-import System.IO.Unsafe ( unsafePerformIO )
 import Data.List        hiding (group)
 import Data.List.NonEmpty  ( NonEmpty(..) )
 
@@ -154,7 +149,6 @@ import GHC.Stack (HasCallStack)
 import Control.Applicative ( liftA2 )
 import Control.Monad    ( liftM, guard )
 import Control.Monad.IO.Class ( MonadIO, liftIO )
-import GHC.Conc.Sync ( sharedCAF )
 import System.IO.Error as IO ( isDoesNotExistError )
 import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
 import System.FilePath
@@ -1070,48 +1064,6 @@ strictMap f (x : xs) =
   in
     x' : xs'
 
-{-
-************************************************************************
-*                                                                      *
-                        Globals and the RTS
-*                                                                      *
-************************************************************************
-
-When a plugin is loaded, it currently gets linked against a *newly
-loaded* copy of the GHC package. This would not be a problem, except
-that the new copy has its own mutable state that is not shared with
-that state that has already been initialized by the original GHC
-package.
-
-(Note that if the GHC executable was dynamically linked this
-wouldn't be a problem, because we could share the GHC library it
-links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
-
-The solution is to make use of @sharedCAF@ through @sharedGlobal@
-for globals that are shared between multiple copies of ghc packages.
--}
-
--- Global variables:
-
-global :: a -> IORef a
-global a = unsafePerformIO (newIORef a)
-
-consIORef :: IORef [a] -> a -> IO ()
-consIORef var x = do
-  atomicModifyIORef' var (\xs -> (x:xs,()))
-
-globalM :: IO a -> IORef a
-globalM ma = unsafePerformIO (ma >>= newIORef)
-
--- Shared global variables:
-
-sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
-sharedGlobal a get_or_set = unsafePerformIO $
-  newIORef a >>= flip sharedCAF get_or_set
-
-sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
-sharedGlobalM ma get_or_set = unsafePerformIO $
-  ma >>= newIORef >>= flip sharedCAF get_or_set
 
 -- Module names:
 

compiler/GHC/Utils/Panic.hs

@@ -47,8 +47,6 @@ import GHC.Prelude
 import GHC.Stack
 
 import GHC.Utils.Outputable
-import {-# SOURCE #-} GHC.Driver.Session (DynFlags, unsafeGlobalDynFlags)
-import {-# SOURCE #-} GHC.Driver.Ppr (showSDoc)
 import GHC.Utils.Panic.Plain
 
 import GHC.Utils.Exception as Exception
@@ -146,16 +144,14 @@ safeShowException e = do
 
 -- | Append a description of the given exception to this string.
 --
--- Note that this uses 'GHC.Driver.Session.unsafeGlobalDynFlags', which may have some
--- uninitialized fields if invoked before 'GHC.initGhcMonad' has been called.
--- If the error message to be printed includes a pretty-printer document
--- which forces one of these fields this call may bottom.
+-- Note that this uses 'defaultSDocContext', which doesn't use the options
+-- set by the user via DynFlags.
 showGhcExceptionUnsafe :: GhcException -> ShowS
-showGhcExceptionUnsafe = showGhcException unsafeGlobalDynFlags
+showGhcExceptionUnsafe = showGhcException defaultSDocContext
 
 -- | Append a description of the given exception to this string.
-showGhcException :: DynFlags -> GhcException -> ShowS
-showGhcException dflags = showPlainGhcException . \case
+showGhcException :: SDocContext -> GhcException -> ShowS
+showGhcException ctx = showPlainGhcException . \case
   Signal n -> PlainSignal n
   UsageError str -> PlainUsageError str
   CmdLineError str -> PlainCmdLineError str
@@ -165,11 +161,11 @@ showGhcException dflags = showPlainGhcException . \case
   ProgramError str -> PlainProgramError str
 
   PprPanic str sdoc -> PlainPanic $
-      concat [str, "\n\n", showSDoc dflags sdoc]
+      concat [str, "\n\n", renderWithContext ctx sdoc]
   PprSorry str sdoc -> PlainProgramError $
-      concat [str, "\n\n", showSDoc dflags sdoc]
+      concat [str, "\n\n", renderWithContext ctx sdoc]
   PprProgramError str sdoc -> PlainProgramError $
-      concat [str, "\n\n", showSDoc dflags sdoc]
+      concat [str, "\n\n", renderWithContext ctx sdoc]
 
 throwGhcException :: GhcException -> a
 throwGhcException = Exception.throw

compiler/HsVersions.h

@@ -15,25 +15,25 @@ you will screw up the layout where they are used in case expressions!
 #define GLOBAL_VAR(name,value,ty)  \
 {-# NOINLINE name #-};             \
 name :: IORef (ty);                \
-name = GHC.Utils.Misc.global (value);
+name = GHC.Utils.GlobalVars.global (value);
 
 #define GLOBAL_VAR_M(name,value,ty) \
 {-# NOINLINE name #-};              \
 name :: IORef (ty);                 \
-name = GHC.Utils.Misc.globalM (value);
+name = GHC.Utils.GlobalVars.globalM (value);
 
 
 #define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
 {-# NOINLINE name #-};                                      \
 name :: IORef (ty);                                         \
-name = GHC.Utils.Misc.sharedGlobal (value) (accessor);      \
+name = GHC.Utils.GlobalVars.sharedGlobal (value) (accessor);\
 foreign import ccall unsafe saccessor                       \
   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
 
 #define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \
 {-# NOINLINE name #-};                                         \
 name :: IORef (ty);                                            \
-name = GHC.Utils.Misc.sharedGlobalM (value) (accessor);        \
+name = GHC.Utils.GlobalVars.sharedGlobalM (value) (accessor);  \
 foreign import ccall unsafe saccessor                          \
   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
 

compiler/ghc.cabal.in

@@ -177,6 +177,7 @@ Library
         GHC.Types.Cpr
         GHC.Cmm.DebugBlock
         GHC.Utils.Exception
+        GHC.Utils.GlobalVars
         GHC.Types.FieldLabel
         GHC.Driver.Monad
         GHC.Driver.Hooks

includes/rts/Globals.h

@@ -31,6 +31,8 @@ mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)
 mkStoreAccessorPrototype(LibHSghcFastStringTable)
 mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)
 mkStoreAccessorPrototype(LibHSghcInitLinkerDone)
-mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)
+mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug)
+mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput)
+mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack)
 mkStoreAccessorPrototype(LibHSghcStaticOptions)
 mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)

rts/Globals.c

@@ -35,7 +35,9 @@ typedef enum {
     LibHSghcFastStringTable,
     LibHSghcPersistentLinkerState,
     LibHSghcInitLinkerDone,
-    LibHSghcGlobalDynFlags,
+    LibHSghcGlobalHasPprDebug,
+    LibHSghcGlobalHasNoDebugOutput,
+    LibHSghcGlobalHasNoStateHack,
     LibHSghcStaticOptions,
     LibHSghcStaticOptionsReady,
     MaxStoreKey
@@ -108,6 +110,8 @@ mkStoreAccessor(SystemTimerThreadIOManagerThreadStore)
 mkStoreAccessor(LibHSghcFastStringTable)
 mkStoreAccessor(LibHSghcPersistentLinkerState)
 mkStoreAccessor(LibHSghcInitLinkerDone)
-mkStoreAccessor(LibHSghcGlobalDynFlags)
+mkStoreAccessor(LibHSghcGlobalHasPprDebug)
+mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput)
+mkStoreAccessor(LibHSghcGlobalHasNoStateHack)
 mkStoreAccessor(LibHSghcStaticOptions)
 mkStoreAccessor(LibHSghcStaticOptionsReady)

rts/RtsSymbols.c

@@ -644,7 +644,9 @@
       SymI_HasProto(getRTSStatsEnabled)                                 \
       SymI_HasProto(getOrSetLibHSghcPersistentLinkerState)              \
       SymI_HasProto(getOrSetLibHSghcInitLinkerDone)                     \
-      SymI_HasProto(getOrSetLibHSghcGlobalDynFlags)                     \
+      SymI_HasProto(getOrSetLibHSghcGlobalHasPprDebug)                  \
+      SymI_HasProto(getOrSetLibHSghcGlobalHasNoDebugOutput)             \
+      SymI_HasProto(getOrSetLibHSghcGlobalHasNoStateHack)               \
       SymI_HasProto(genericRaise)                                       \
       SymI_HasProto(getProgArgv)                                        \
       SymI_HasProto(getFullProgArgv)                                    \

testsuite/tests/plugins/LinkerTicklingPlugin.hs

@@ -2,14 +2,19 @@ module LinkerTicklingPlugin where
 
 import GHC.Plugins
 import GHC.Driver.Session
+import GHC.Utils.GlobalVars
 
 plugin :: Plugin
-plugin = defaultPlugin {
-        installCoreToDos = install
-    }
+plugin = defaultPlugin
+   { installCoreToDos = install
+   }
 
 -- This tests whether plugins are linking against the *running* GHC or a new
 -- instance of it. If it is a new instance (settings unsafeGlobalDynFlags) won't
 -- have been initialised, so we'll get a GHC panic here:
 install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
-install _options todos = settings unsafeGlobalDynFlags `seq` return todos
+install _options todos = io `seq` return todos
+   where
+      io = if not unsafeHasPprDebug
+            then error "unsafePprDebug should be set: plugin linked against a different GHC?"
+            else ()

testsuite/tests/plugins/all.T

@@ -44,7 +44,7 @@ test('plugins06',
      [extra_files(['LinkerTicklingPlugin.hs']),
       unless(have_dynamic(), skip),
       only_ways([config.ghc_plugin_way])],
-     multimod_compile_and_run, ['plugins06', '-package ghc'])
+     multimod_compile_and_run, ['plugins06', '-package ghc -dppr-debug'])
 
 test('plugins07',
      [extra_files(['rule-defining-plugin/']),