Commit c3c70244 authored by Moritz Angermann's avatar Moritz Angermann Committed by Tamar Christina

Make globals use sharedCAF

Summary:
The use of globals is quite painful when multiple rts are loaded, e.g.
when plugins are loaded, which bring in a second rts. The sharedCAF
appraoch was employed for the FastStringTable; I've taken the libery
to extend this to the other globals I could find.

This is a reboot of D2575, that should hopefully not exhibit the same
windows build issues.

Reviewers: Phyx, simonmar, goldfire, bgamari, austin, hvr, erikd

Reviewed By: Phyx, simonmar, bgamari

Subscribers: mpickering, thomie

Differential Revision: https://phabricator.haskell.org/D2773
parent 490b9429
...@@ -32,6 +32,22 @@ name = Util.global (value); ...@@ -32,6 +32,22 @@ name = Util.global (value);
name :: IORef (ty); \ name :: IORef (ty); \
name = Util.globalM (value); name = Util.globalM (value);
#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = Util.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 = Util.sharedGlobalM (value) (accessor); \
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else #define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else #define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $ #define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
......
{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-} {-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-}
{-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-- --
-- (c) The University of Glasgow 2002-2006 -- (c) The University of Glasgow 2002-2006
-- --
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-- | The dynamic linker for GHCi. -- | The dynamic linker for GHCi.
-- --
-- This module deals with the top-level issues of dynamic linking, -- This module deals with the top-level issues of dynamic linking,
...@@ -16,10 +15,7 @@ module Linker ( getHValue, showLinkerState, ...@@ -16,10 +15,7 @@ module Linker ( getHValue, showLinkerState,
extendLinkEnv, deleteFromLinkEnv, extendLinkEnv, deleteFromLinkEnv,
extendLoadedPkgs, extendLoadedPkgs,
linkPackages,initDynLinker,linkModule, linkPackages,initDynLinker,linkModule,
linkCmdLineLibs, linkCmdLineLibs
-- Saving/restoring globals
PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -66,6 +62,11 @@ import System.Directory ...@@ -66,6 +62,11 @@ import System.Directory
import Exception import Exception
#if __GLASGOW_HASKELL__ >= 709
import Foreign
#else
import Foreign.Safe
#endif
{- ********************************************************************** {- **********************************************************************
...@@ -84,9 +85,22 @@ library to side-effect the PLS and for those changes to be reflected here. ...@@ -84,9 +85,22 @@ library to side-effect the PLS and for those changes to be reflected here.
The PersistentLinkerState maps Names to actual closures (for The PersistentLinkerState maps Names to actual closures (for
interpreted code only), for use during linking. interpreted code only), for use during linking.
-} -}
#if STAGE < 2
GLOBAL_VAR_M(v_PersistentLinkerState, newMVar (panic "Dynamic linker not initialised"), MVar PersistentLinkerState) GLOBAL_VAR_M(v_PersistentLinkerState, newMVar (panic "Dynamic linker not initialised"), MVar PersistentLinkerState)
GLOBAL_VAR(v_InitLinkerDone, False, Bool) -- Set True when dynamic linker is initialised GLOBAL_VAR(v_InitLinkerDone, False, Bool) -- Set True when dynamic linker is initialised
#else
SHARED_GLOBAL_VAR_M( v_PersistentLinkerState
, getOrSetLibHSghcPersistentLinkerState
, "getOrSetLibHSghcPersistentLinkerState"
, newMVar (panic "Dynamic linker not initialised")
, MVar PersistentLinkerState)
-- Set True when dynamic linker is initialised
SHARED_GLOBAL_VAR( v_InitLinkerDone
, getOrSetLibHSghcInitLinkerDone
, "getOrSetLibHSghcInitLinkerDone"
, False
, Bool)
#endif
modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO () modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO ()
modifyPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f modifyPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f
...@@ -1428,17 +1442,3 @@ maybePutStr dflags s ...@@ -1428,17 +1442,3 @@ maybePutStr dflags s
maybePutStrLn :: DynFlags -> String -> IO () maybePutStrLn :: DynFlags -> String -> IO ()
maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n") maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n")
{- **********************************************************************
Tunneling global variables into new instance of GHC library
********************************************************************* -}
saveLinkerGlobals :: IO (MVar PersistentLinkerState, Bool)
saveLinkerGlobals = liftM2 (,) (readIORef v_PersistentLinkerState) (readIORef v_InitLinkerDone)
restoreLinkerGlobals :: (MVar PersistentLinkerState, Bool) -> IO ()
restoreLinkerGlobals (pls, ild) = do
writeIORef v_PersistentLinkerState pls
writeIORef v_InitLinkerDone ild
...@@ -221,7 +221,6 @@ import System.Console.Terminfo (SetupTermError, Terminal, getCapability, ...@@ -221,7 +221,6 @@ import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
setupTermFromEnv, termColors) setupTermFromEnv, termColors)
import System.Posix (queryTerminal, stdError) import System.Posix (queryTerminal, stdError)
#elif defined mingw32_HOST_OS #elif defined mingw32_HOST_OS
import Foreign (Ptr, with, peek)
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import qualified Graphics.Win32 as Win32 import qualified Graphics.Win32 as Win32
#endif #endif
...@@ -234,6 +233,13 @@ import qualified Data.IntSet as IntSet ...@@ -234,6 +233,13 @@ import qualified Data.IntSet as IntSet
import GHC.Foreign (withCString, peekCString) import GHC.Foreign (withCString, peekCString)
import qualified GHC.LanguageExtensions as LangExt import qualified GHC.LanguageExtensions as LangExt
#if __GLASGOW_HASKELL__ >= 709
import Foreign
#else
import Foreign.Safe
#endif
-- Note [Updating flag description in the User's Guide] -- Note [Updating flag description in the User's Guide]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- --
...@@ -5142,7 +5148,15 @@ defaultGlobalDynFlags = ...@@ -5142,7 +5148,15 @@ defaultGlobalDynFlags =
where where
settings = panic "v_unsafeGlobalDynFlags: not initialised" settings = panic "v_unsafeGlobalDynFlags: not initialised"
#if STAGE < 2
GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
#else
SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags
, getOrSetLibHSghcGlobalDynFlags
, "getOrSetLibHSghcGlobalDynFlags"
, defaultGlobalDynFlags
, DynFlags )
#endif
unsafeGlobalDynFlags :: DynFlags unsafeGlobalDynFlags :: DynFlags
unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
......
...@@ -48,6 +48,12 @@ import Control.Monad ...@@ -48,6 +48,12 @@ import Control.Monad
import Data.IORef import Data.IORef
import System.IO.Unsafe ( unsafePerformIO ) import System.IO.Unsafe ( unsafePerformIO )
#if __GLASGOW_HASKELL__ >= 709
import Foreign
#else
import Foreign.Safe
#endif
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Static flags -- Static flags
...@@ -91,9 +97,21 @@ parseStaticFlagsFull flagsAvailable args = do ...@@ -91,9 +97,21 @@ parseStaticFlagsFull flagsAvailable args = do
-- holds the static opts while they're being collected, before -- holds the static opts while they're being collected, before
-- being unsafely read by unpacked_static_opts below. -- being unsafely read by unpacked_static_opts below.
#if STAGE < 2
GLOBAL_VAR(v_opt_C, [], [String]) GLOBAL_VAR(v_opt_C, [], [String])
GLOBAL_VAR(v_opt_C_ready, False, Bool) GLOBAL_VAR(v_opt_C_ready, False, Bool)
#else
SHARED_GLOBAL_VAR( v_opt_C
, getOrSetLibHSghcStaticOptions
, "getOrSetLibHSghcStaticOptions"
, []
, [String])
SHARED_GLOBAL_VAR( v_opt_C_ready
, getOrSetLibHSghcStaticOptionsReady
, "getOrSetLibHSghcStaticOptionsReady"
, False
, Bool)
#endif
staticFlags :: [String] staticFlags :: [String]
staticFlags = unsafePerformIO $ do staticFlags = unsafePerformIO $ do
......
...@@ -95,16 +95,8 @@ import Control.Applicative ( Alternative(..) ) ...@@ -95,16 +95,8 @@ import Control.Applicative ( Alternative(..) )
import Prelude hiding ( read ) import Prelude hiding ( read )
#ifdef GHCI #ifdef GHCI
import Control.Concurrent.MVar (MVar)
import Linker ( PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals )
import {-# SOURCE #-} TcSplice ( lookupThName_maybe ) import {-# SOURCE #-} TcSplice ( lookupThName_maybe )
import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH as TH
#else
saveLinkerGlobals :: IO ()
saveLinkerGlobals = return ()
restoreLinkerGlobals :: () -> IO ()
restoreLinkerGlobals () = return ()
#endif #endif
{- {-
...@@ -509,12 +501,7 @@ data CoreReader = CoreReader { ...@@ -509,12 +501,7 @@ data CoreReader = CoreReader {
cr_print_unqual :: PrintUnqualified, cr_print_unqual :: PrintUnqualified,
cr_loc :: SrcSpan, -- Use this for log/error messages so they cr_loc :: SrcSpan, -- Use this for log/error messages so they
-- are at least tagged with the right source file -- are at least tagged with the right source file
cr_visible_orphan_mods :: !ModuleSet, cr_visible_orphan_mods :: !ModuleSet
#ifdef GHCI
cr_globals :: (MVar PersistentLinkerState, Bool)
#else
cr_globals :: ()
#endif
} }
-- Note: CoreWriter used to be defined with data, rather than newtype. If it -- Note: CoreWriter used to be defined with data, rather than newtype. If it
...@@ -586,15 +573,13 @@ runCoreM :: HscEnv ...@@ -586,15 +573,13 @@ runCoreM :: HscEnv
-> CoreM a -> CoreM a
-> IO (a, SimplCount) -> IO (a, SimplCount)
runCoreM hsc_env rule_base us mod orph_imps print_unqual loc m runCoreM hsc_env rule_base us mod orph_imps print_unqual loc m
= do { glbls <- saveLinkerGlobals = liftM extract $ runIOEnv reader $ unCoreM m state
; liftM extract $ runIOEnv (reader glbls) $ unCoreM m state }
where where
reader glbls = CoreReader { reader = CoreReader {
cr_hsc_env = hsc_env, cr_hsc_env = hsc_env,
cr_rule_base = rule_base, cr_rule_base = rule_base,
cr_module = mod, cr_module = mod,
cr_visible_orphan_mods = orph_imps, cr_visible_orphan_mods = orph_imps,
cr_globals = glbls,
cr_print_unqual = print_unqual, cr_print_unqual = print_unqual,
cr_loc = loc cr_loc = loc
} }
...@@ -690,59 +675,9 @@ getPackageFamInstEnv = do ...@@ -690,59 +675,9 @@ getPackageFamInstEnv = do
eps <- liftIO $ hscEPS hsc_env eps <- liftIO $ hscEPS hsc_env
return $ eps_fam_inst_env eps return $ eps_fam_inst_env eps
{- {-# DEPRECATED reinitializeGlobals "It is not necessary to call reinitializeGlobals. Since GHC 8.2, this function is a no-op and will be removed in GHC 8.4" #-}
************************************************************************
* *
Initializing globals
* *
************************************************************************
This is a rather annoying function. 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.
(NB This mechanism is sufficient for granting plugins read-only access to
globals that are guaranteed to be initialized before the plugin is loaded. If
any further synchronization is necessary, I would suggest using the more
sophisticated mechanism involving GHC.Conc.Sync.sharedCAF and rts/Globals.c to
share a single instance of the global variable among the compiler and the
plugins. Perhaps we should migrate all global variables to use that mechanism,
for robustness... -- NSF July 2013)
This leads to loaded plugins calling GHC code which pokes the static flags,
and then dying with a panic because the static flags *it* sees are uninitialized.
There are two possible solutions:
1. Export the symbols from the GHC executable from the GHC library and link
against this existing copy rather than a new copy of the GHC library
2. Carefully ensure that the global state in the two copies of the GHC
library matches
I tried 1. and it *almost* works (and speeds up plugin load times!) except
on Windows. On Windows the GHC library tends to export more than 65536 symbols
(see #5292) which overflows the limit of what we can export from the EXE and
causes breakage.
(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.)
We are going to try 2. instead. Unfortunately, this means that every plugin
will have to say `reinitializeGlobals` before it does anything, but never mind.
I've threaded the cr_globals through CoreM rather than giving them as an
argument to the plugin function so that we can turn this function into
(return ()) without breaking any plugins when we eventually get 1. working.
-}
reinitializeGlobals :: CoreM () reinitializeGlobals :: CoreM ()
reinitializeGlobals = do reinitializeGlobals = return ()
linker_globals <- read cr_globals
hsc_env <- getHscEnv
let dflags = hsc_dflags hsc_env
liftIO $ restoreLinkerGlobals linker_globals
liftIO $ setUnsafeGlobalDynFlags dflags
{- {-
************************************************************************ ************************************************************************
......
...@@ -285,13 +285,6 @@ originally assigned to those FastStrings. Thus the lookup fails since the ...@@ -285,13 +285,6 @@ originally assigned to those FastStrings. Thus the lookup fails since the
domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
unique. unique.
The old `reinitializeGlobals` mechanism is enough to provide the plugin with
read-access to the table, but it insufficient in the general case where the
plugin may allocate FastStrings. This mutates the supply for the FastStrings'
unique, and that needs to be propagated back to the compiler's instance of the
global variable. Such propagation is beyond the `reinitializeGlobals`
mechanism.
Maintaining synchronization of the two instances of this global is rather Maintaining synchronization of the two instances of this global is rather
difficult because of the uses of `unsafePerformIO` in this module. Not difficult because of the uses of `unsafePerformIO` in this module. Not
synchronizing them risks breaking the rather major invariant that two synchronizing them risks breaking the rather major invariant that two
......
...@@ -104,6 +104,7 @@ module Util ( ...@@ -104,6 +104,7 @@ module Util (
hSetTranslit, hSetTranslit,
global, consIORef, globalM, global, consIORef, globalM,
sharedGlobal, sharedGlobalM,
-- * Filenames and paths -- * Filenames and paths
Suffix, Suffix,
...@@ -144,6 +145,7 @@ import qualified GHC.Stack ...@@ -144,6 +145,7 @@ import qualified GHC.Stack
import Control.Applicative ( liftA2 ) import Control.Applicative ( liftA2 )
import Control.Monad ( liftM ) import Control.Monad ( liftM )
import GHC.IO.Encoding (mkTextEncoding, textEncodingName) import GHC.IO.Encoding (mkTextEncoding, textEncodingName)
import GHC.Conc.Sync ( sharedCAF )
import System.IO (Handle, hGetEncoding, hSetEncoding) import System.IO (Handle, hGetEncoding, hSetEncoding)
import System.IO.Error as IO ( isDoesNotExistError ) import System.IO.Error as IO ( isDoesNotExistError )
import System.Directory ( doesDirectoryExist, getModificationTime ) import System.Directory ( doesDirectoryExist, getModificationTime )
...@@ -930,6 +932,28 @@ seqList :: [a] -> b -> b ...@@ -930,6 +932,28 @@ seqList :: [a] -> b -> b
seqList [] b = b seqList [] b = b
seqList (x:xs) b = x `seq` seqList xs b seqList (x:xs) b = x `seq` seqList xs b
{-
************************************************************************
* *
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 variables:
global :: a -> IORef a global :: a -> IORef a
...@@ -942,6 +966,16 @@ consIORef var x = do ...@@ -942,6 +966,16 @@ consIORef var x = do
globalM :: IO a -> IORef a globalM :: IO a -> IORef a
globalM ma = unsafePerformIO (ma >>= newIORef) 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: -- Module names:
looksLikeModuleName :: String -> Bool looksLikeModuleName :: String -> Bool
......
...@@ -305,7 +305,6 @@ just returns the original compilation pipeline, unmodified, and says ...@@ -305,7 +305,6 @@ just returns the original compilation pipeline, unmodified, and says
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do install _ todo = do
reinitializeGlobals
putMsgS "Hello!" putMsgS "Hello!"
return todo return todo
...@@ -314,16 +313,6 @@ cabal for instance,) you can then use it by just specifying ...@@ -314,16 +313,6 @@ cabal for instance,) you can then use it by just specifying
``-fplugin=DoNothing.Plugin`` on the command line, and during the ``-fplugin=DoNothing.Plugin`` on the command line, and during the
compilation you should see GHC say 'Hello'. compilation you should see GHC say 'Hello'.
Note carefully the ``reinitializeGlobals`` call at the beginning of the
installation function. Due to bugs in the windows linker dealing with
``libghc``, this call is necessary to properly ensure compiler plugins
have the same global state as GHC at the time of invocation. Without
``reinitializeGlobals``, compiler plugins can crash at runtime because
they may require state that hasn't otherwise been initialized.
In the future, when the linking bugs are fixed, ``reinitializeGlobals``
will be deprecated with a warning, and changed to do nothing.
.. _core-plugins-in-more-detail: .. _core-plugins-in-more-detail:
Core plugins in more detail Core plugins in more detail
...@@ -396,7 +385,6 @@ in a module it compiles: ...@@ -396,7 +385,6 @@ in a module it compiles:
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do install _ todo = do
reinitializeGlobals
return (CoreDoPluginPass "Say name" pass : todo) return (CoreDoPluginPass "Say name" pass : todo)
pass :: ModGuts -> CoreM ModGuts pass :: ModGuts -> CoreM ModGuts
...@@ -446,7 +434,6 @@ will print out the name of any top-level non-recursive binding with the ...@@ -446,7 +434,6 @@ will print out the name of any top-level non-recursive binding with the
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do install _ todo = do
reinitializeGlobals
return (CoreDoPluginPass "Say name" pass : todo) return (CoreDoPluginPass "Say name" pass : todo)
pass :: ModGuts -> CoreM ModGuts pass :: ModGuts -> CoreM ModGuts
......
...@@ -17,14 +17,23 @@ ...@@ -17,14 +17,23 @@
#ifndef RTS_GLOBALS_H #ifndef RTS_GLOBALS_H
#define RTS_GLOBALS_H #define RTS_GLOBALS_H
StgStablePtr getOrSetGHCConcSignalSignalHandlerStore(StgStablePtr value); #define mkStoreAccessorPrototype(name) \
StgStablePtr getOrSetGHCConcWindowsPendingDelaysStore(StgStablePtr ptr); StgStablePtr \
StgStablePtr getOrSetGHCConcWindowsIOManagerThreadStore(StgStablePtr ptr); getOrSet##name(StgStablePtr ptr);
StgStablePtr getOrSetGHCConcWindowsProddingStore(StgStablePtr ptr);
StgStablePtr getOrSetSystemEventThreadEventManagerStore(StgStablePtr ptr); mkStoreAccessorPrototype(GHCConcSignalSignalHandlerStore)
StgStablePtr getOrSetSystemEventThreadIOManagerThreadStore(StgStablePtr ptr); mkStoreAccessorPrototype(GHCConcWindowsPendingDelaysStore)
StgStablePtr getOrSetSystemTimerThreadEventManagerStore(StgStablePtr ptr); mkStoreAccessorPrototype(GHCConcWindowsIOManagerThreadStore)
StgStablePtr getOrSetSystemTimerThreadIOManagerThreadStore(StgStablePtr ptr); mkStoreAccessorPrototype(GHCConcWindowsProddingStore)
StgStablePtr getOrSetLibHSghcFastStringTable(StgStablePtr ptr); mkStoreAccessorPrototype(SystemEventThreadEventManagerStore)
mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore)
mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore)
mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)
mkStoreAccessorPrototype(LibHSghcFastStringTable)
mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)
mkStoreAccessorPrototype(LibHSghcInitLinkerDone)
mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)
mkStoreAccessorPrototype(LibHSghcStaticOptions)
mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)
#endif /* RTS_GLOBALS_H */ #endif /* RTS_GLOBALS_H */
...@@ -856,7 +856,7 @@ modifyMVar_ m io = ...@@ -856,7 +856,7 @@ modifyMVar_ m io =
-- Thread waiting -- Thread waiting
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Machinery needed to ensureb that we only have one copy of certain -- Machinery needed to ensure that we only have one copy of certain
-- CAFs in this module even when the base package is present twice, as -- CAFs in this module even when the base package is present twice, as
-- it is when base is dynamically loaded into GHCi. The RTS keeps -- it is when base is dynamically loaded into GHCi. The RTS keeps
-- track of the single true value of the CAF, so even when the CAFs in -- track of the single true value of the CAF, so even when the CAFs in
......
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
* dynamically loads * dynamically loads
* *
* libHSghc - a statically-linked ghc has its own copy and so will Core * libHSghc - a statically-linked ghc has its own copy and so will Core
* plugins it dynamically loads (cf CoreMonad.reinitializeGlobals) * plugins it dynamically loads.
* *
* ---------------------------------------------------------------------------*/ * ---------------------------------------------------------------------------*/
...@@ -33,6 +33,11 @@ typedef enum { ...@@ -33,6 +33,11 @@ typedef enum {
SystemTimerThreadEventManagerStore, SystemTimerThreadEventManagerStore,
SystemTimerThreadIOManagerThreadStore, SystemTimerThreadIOManagerThreadStore,
LibHSghcFastStringTable, LibHSghcFastStringTable,
LibHSghcPersistentLinkerState,
LibHSghcInitLinkerDone,
LibHSghcGlobalDynFlags,
LibHSghcStaticOptions,
LibHSghcStaticOptionsReady,
MaxStoreKey MaxStoreKey
} StoreKey; } StoreKey;
...@@ -87,56 +92,22 @@ static StgStablePtr getOrSetKey(StoreKey key, StgStablePtr ptr) ...@@ -87,56 +92,22 @@ static StgStablePtr getOrSetKey(StoreKey key, StgStablePtr ptr)
return ret; return ret;
} }
StgStablePtr #define mkStoreAccessor(name) \
getOrSetGHCConcSignalSignalHandlerStore(StgStablePtr ptr) StgStablePtr \
{ getOrSet##name(StgStablePtr ptr) \
return getOrSetKey(GHCConcSignalSignalHandlerStore,ptr); { return getOrSetKey(name, ptr); }
}
mkStoreAccessor(GHCConcSignalSignalHandlerStore)
StgStablePtr mkStoreAccessor(GHCConcWindowsPendingDelaysStore)
getOrSetGHCConcWindowsPendingDelaysStore(StgStablePtr ptr)