[Git][ghc/ghc][master] 2 commits: Remove unsafeGlobalDynFlags (#17957, #14597)
Marge Bot
gitlab at gitlab.haskell.org
Wed Sep 30 06:49:49 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00
Remove unsafeGlobalDynFlags (#17957, #14597)
There are still global variables but only 3 booleans instead of a single
DynFlags.
- - - - -
9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00
Remove unused global variables
Some removed globals variables were still declared in the RTS.
They were removed in the following commits:
* 4fc6524a2a4a0003495a96c8b84783286f65c198
* 0dc7985663efa1739aafb480759e2e2e7fca2a36
* bbd3c399939311ec3e308721ab87ca6b9443f358
- - - - -
17 changed files:
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Driver/Ppr.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Driver/Session.hs-boot
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Utils/Error.hs
- + compiler/GHC/Utils/GlobalVars.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Panic.hs
- compiler/HsVersions.h
- compiler/ghc.cabal.in
- includes/rts/Globals.h
- rts/Globals.c
- rts/RtsSymbols.c
- testsuite/tests/plugins/LinkerTicklingPlugin.hs
- testsuite/tests/plugins/all.T
Changes:
=====================================
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 at .
-- 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
=====================================
@@ -0,0 +1,112 @@
+{-# 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
=====================================
@@ -29,8 +29,6 @@ mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore)
mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore)
mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)
mkStoreAccessorPrototype(LibHSghcFastStringTable)
-mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)
-mkStoreAccessorPrototype(LibHSghcInitLinkerDone)
-mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)
-mkStoreAccessorPrototype(LibHSghcStaticOptions)
-mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)
+mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug)
+mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput)
+mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack)
=====================================
rts/Globals.c
=====================================
@@ -33,11 +33,9 @@ typedef enum {
SystemTimerThreadEventManagerStore,
SystemTimerThreadIOManagerThreadStore,
LibHSghcFastStringTable,
- LibHSghcPersistentLinkerState,
- LibHSghcInitLinkerDone,
- LibHSghcGlobalDynFlags,
- LibHSghcStaticOptions,
- LibHSghcStaticOptionsReady,
+ LibHSghcGlobalHasPprDebug,
+ LibHSghcGlobalHasNoDebugOutput,
+ LibHSghcGlobalHasNoStateHack,
MaxStoreKey
} StoreKey;
@@ -106,8 +104,6 @@ mkStoreAccessor(SystemEventThreadIOManagerThreadStore)
mkStoreAccessor(SystemTimerThreadEventManagerStore)
mkStoreAccessor(SystemTimerThreadIOManagerThreadStore)
mkStoreAccessor(LibHSghcFastStringTable)
-mkStoreAccessor(LibHSghcPersistentLinkerState)
-mkStoreAccessor(LibHSghcInitLinkerDone)
-mkStoreAccessor(LibHSghcGlobalDynFlags)
-mkStoreAccessor(LibHSghcStaticOptions)
-mkStoreAccessor(LibHSghcStaticOptionsReady)
+mkStoreAccessor(LibHSghcGlobalHasPprDebug)
+mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput)
+mkStoreAccessor(LibHSghcGlobalHasNoStateHack)
=====================================
rts/RtsSymbols.c
=====================================
@@ -642,9 +642,9 @@
SymI_HasProto(getOrSetLibHSghcFastStringTable) \
SymI_HasProto(getRTSStats) \
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/']),
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6527fc57b8e099703f5bdb5ec7f1dfd421651972...9befd94d79a78fd53a28a4ce051a91d2215d069c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6527fc57b8e099703f5bdb5ec7f1dfd421651972...9befd94d79a78fd53a28a4ce051a91d2215d069c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200930/a1d028e1/attachment-0001.html>
More information about the ghc-commits
mailing list