diff options
| -rw-r--r-- | compiler/HsVersions.h | 16 | ||||
| -rw-r--r-- | compiler/ghci/Linker.hs | 44 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 15 | ||||
| -rw-r--r-- | compiler/main/StaticFlags.hs | 20 | ||||
| -rw-r--r-- | compiler/simplCore/CoreMonad.hs | 75 | ||||
| -rw-r--r-- | compiler/utils/FastString.hs | 7 | ||||
| -rw-r--r-- | compiler/utils/Util.hs | 34 | ||||
| -rw-r--r-- | docs/users_guide/extending_ghc.rst | 13 | ||||
| -rw-r--r-- | includes/rts/Globals.h | 27 | ||||
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 2 | ||||
| -rw-r--r-- | rts/Globals.c | 79 | ||||
| -rw-r--r-- | testsuite/tests/plugins/LinkerTicklingPlugin.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs | 1 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs | 1 |
14 files changed, 182 insertions, 156 deletions
diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h index 4a0b04ad70..83cbcf15cb 100644 --- a/compiler/HsVersions.h +++ b/compiler/HsVersions.h @@ -32,22 +32,6 @@ name = Util.global (value); name :: IORef (ty); \ 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 ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else #define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $ diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 7379c46772..4a0b62f904 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -1,10 +1,11 @@ {-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-} {-# OPTIONS_GHC -fno-cse #-} --- -fno-cse is needed for GLOBAL_VAR's to behave properly - -- -- (c) The University of Glasgow 2002-2006 -- + +-- -fno-cse is needed for GLOBAL_VAR's to behave properly + -- | The dynamic linker for GHCi. -- -- This module deals with the top-level issues of dynamic linking, @@ -15,7 +16,10 @@ module Linker ( getHValue, showLinkerState, extendLinkEnv, deleteFromLinkEnv, extendLoadedPkgs, linkPackages,initDynLinker,linkModule, - linkCmdLineLibs + linkCmdLineLibs, + + -- Saving/restoring globals + PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals ) where #include "HsVersions.h" @@ -62,11 +66,6 @@ import System.Directory import Exception -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif {- ********************************************************************** @@ -85,22 +84,9 @@ library to side-effect the PLS and for those changes to be reflected here. The PersistentLinkerState maps Names to actual closures (for 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(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_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f @@ -1442,3 +1428,17 @@ maybePutStr dflags s maybePutStrLn :: DynFlags -> String -> IO () 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 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c35834f935..f56ec63ead 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -232,13 +232,6 @@ import qualified Data.IntSet as IntSet import GHC.Foreign (withCString, peekCString) 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] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- @@ -5144,15 +5137,7 @@ defaultGlobalDynFlags = where settings = panic "v_unsafeGlobalDynFlags: not initialised" -#if 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 diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index af8f4e64d4..a89f3c54ab 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -48,12 +48,6 @@ import Control.Monad import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif - ----------------------------------------------------------------------------- -- Static flags @@ -97,21 +91,9 @@ parseStaticFlagsFull flagsAvailable args = do -- holds the static opts while they're being collected, before -- being unsafely read by unpacked_static_opts below. -#if STAGE < 2 GLOBAL_VAR(v_opt_C, [], [String]) 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 = unsafePerformIO $ do diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 0667675d7e..314d0945d5 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -95,8 +95,16 @@ import Control.Applicative ( Alternative(..) ) import Prelude hiding ( read ) #ifdef GHCI +import Control.Concurrent.MVar (MVar) +import Linker ( PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals ) import {-# SOURCE #-} TcSplice ( lookupThName_maybe ) import qualified Language.Haskell.TH as TH +#else +saveLinkerGlobals :: IO () +saveLinkerGlobals = return () + +restoreLinkerGlobals :: () -> IO () +restoreLinkerGlobals () = return () #endif {- @@ -501,7 +509,12 @@ data CoreReader = CoreReader { cr_print_unqual :: PrintUnqualified, cr_loc :: SrcSpan, -- Use this for log/error messages so they -- 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 @@ -573,13 +586,15 @@ runCoreM :: HscEnv -> CoreM a -> IO (a, SimplCount) runCoreM hsc_env rule_base us mod orph_imps print_unqual loc m - = liftM extract $ runIOEnv reader $ unCoreM m state + = do { glbls <- saveLinkerGlobals + ; liftM extract $ runIOEnv (reader glbls) $ unCoreM m state } where - reader = CoreReader { + reader glbls = CoreReader { cr_hsc_env = hsc_env, cr_rule_base = rule_base, cr_module = mod, cr_visible_orphan_mods = orph_imps, + cr_globals = glbls, cr_print_unqual = print_unqual, cr_loc = loc } @@ -675,9 +690,59 @@ getPackageFamInstEnv = do eps <- liftIO $ hscEPS hsc_env return $ eps_fam_inst_env eps -{-# DEPRECATED reinitializeGlobals "reinitializing globals is now a no-op." #-} +{- +************************************************************************ +* * + 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 = return () +reinitializeGlobals = do + linker_globals <- read cr_globals + hsc_env <- getHscEnv + let dflags = hsc_dflags hsc_env + liftIO $ restoreLinkerGlobals linker_globals + liftIO $ setUnsafeGlobalDynFlags dflags {- ************************************************************************ diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index 8f76584875..1496a8686e 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -285,6 +285,13 @@ 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 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 difficult because of the uses of `unsafePerformIO` in this module. Not synchronizing them risks breaking the rather major invariant that two diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 88b5090f0a..3104c747a1 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -104,7 +104,6 @@ module Util ( hSetTranslit, global, consIORef, globalM, - sharedGlobal, sharedGlobalM, -- * Filenames and paths Suffix, @@ -145,7 +144,6 @@ import qualified GHC.Stack import Control.Applicative ( liftA2 ) import Control.Monad ( liftM ) import GHC.IO.Encoding (mkTextEncoding, textEncodingName) -import GHC.Conc.Sync ( sharedCAF ) import System.IO (Handle, hGetEncoding, hSetEncoding) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime ) @@ -932,28 +930,6 @@ seqList :: [a] -> b -> b seqList [] b = 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 :: a -> IORef a @@ -966,16 +942,6 @@ consIORef var x = do 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: looksLikeModuleName :: String -> Bool diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index c02c93fac1..17d061ec3e 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -305,6 +305,7 @@ just returns the original compilation pipeline, unmodified, and says install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install _ todo = do + reinitializeGlobals putMsgS "Hello!" return todo @@ -313,6 +314,16 @@ cabal for instance,) you can then use it by just specifying ``-fplugin=DoNothing.Plugin`` on the command line, and during the 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 @@ -385,6 +396,7 @@ in a module it compiles: install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install _ todo = do + reinitializeGlobals return (CoreDoPluginPass "Say name" pass : todo) pass :: ModGuts -> CoreM ModGuts @@ -434,6 +446,7 @@ will print out the name of any top-level non-recursive binding with the install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install _ todo = do + reinitializeGlobals return (CoreDoPluginPass "Say name" pass : todo) pass :: ModGuts -> CoreM ModGuts diff --git a/includes/rts/Globals.h b/includes/rts/Globals.h index e3ff643556..00553610f5 100644 --- a/includes/rts/Globals.h +++ b/includes/rts/Globals.h @@ -17,23 +17,14 @@ #ifndef RTS_GLOBALS_H #define RTS_GLOBALS_H -#define mkStoreAccessorPrototype(name) \ - StgStablePtr \ - getOrSet##name(StgStablePtr ptr); - -mkStoreAccessorPrototype(GHCConcSignalSignalHandlerStore) -mkStoreAccessorPrototype(GHCConcWindowsPendingDelaysStore) -mkStoreAccessorPrototype(GHCConcWindowsIOManagerThreadStore) -mkStoreAccessorPrototype(GHCConcWindowsProddingStore) -mkStoreAccessorPrototype(SystemEventThreadEventManagerStore) -mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore) -mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore) -mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore) -mkStoreAccessorPrototype(LibHSghcFastStringTable) -mkStoreAccessorPrototype(LibHSghcPersistentLinkerState) -mkStoreAccessorPrototype(LibHSghcInitLinkerDone) -mkStoreAccessorPrototype(LibHSghcGlobalDynFlags) -mkStoreAccessorPrototype(LibHSghcStaticOptions) -mkStoreAccessorPrototype(LibHSghcStaticOptionsReady) +StgStablePtr getOrSetGHCConcSignalSignalHandlerStore(StgStablePtr value); +StgStablePtr getOrSetGHCConcWindowsPendingDelaysStore(StgStablePtr ptr); +StgStablePtr getOrSetGHCConcWindowsIOManagerThreadStore(StgStablePtr ptr); +StgStablePtr getOrSetGHCConcWindowsProddingStore(StgStablePtr ptr); +StgStablePtr getOrSetSystemEventThreadEventManagerStore(StgStablePtr ptr); +StgStablePtr getOrSetSystemEventThreadIOManagerThreadStore(StgStablePtr ptr); +StgStablePtr getOrSetSystemTimerThreadEventManagerStore(StgStablePtr ptr); +StgStablePtr getOrSetSystemTimerThreadIOManagerThreadStore(StgStablePtr ptr); +StgStablePtr getOrSetLibHSghcFastStringTable(StgStablePtr ptr); #endif /* RTS_GLOBALS_H */ diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 200cdfec74..5986379cb3 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -856,7 +856,7 @@ modifyMVar_ m io = -- Thread waiting ----------------------------------------------------------------------------- --- Machinery needed to ensure that we only have one copy of certain +-- Machinery needed to ensureb that we only have one copy of certain -- 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 -- track of the single true value of the CAF, so even when the CAFs in diff --git a/rts/Globals.c b/rts/Globals.c index b5da6d9295..e3445c8d7b 100644 --- a/rts/Globals.c +++ b/rts/Globals.c @@ -13,7 +13,7 @@ * dynamically loads * * libHSghc - a statically-linked ghc has its own copy and so will Core - * plugins it dynamically loads. + * plugins it dynamically loads (cf CoreMonad.reinitializeGlobals) * * ---------------------------------------------------------------------------*/ @@ -33,11 +33,6 @@ typedef enum { SystemTimerThreadEventManagerStore, SystemTimerThreadIOManagerThreadStore, LibHSghcFastStringTable, - LibHSghcPersistentLinkerState, - LibHSghcInitLinkerDone, - LibHSghcGlobalDynFlags, - LibHSghcStaticOptions, - LibHSghcStaticOptionsReady, MaxStoreKey } StoreKey; @@ -92,22 +87,56 @@ static StgStablePtr getOrSetKey(StoreKey key, StgStablePtr ptr) return ret; } -#define mkStoreAccessor(name) \ - StgStablePtr \ - getOrSet##name(StgStablePtr ptr) \ - { return getOrSetKey(name, ptr); } - -mkStoreAccessor(GHCConcSignalSignalHandlerStore) -mkStoreAccessor(GHCConcWindowsPendingDelaysStore) -mkStoreAccessor(GHCConcWindowsIOManagerThreadStore) -mkStoreAccessor(GHCConcWindowsProddingStore) -mkStoreAccessor(SystemEventThreadEventManagerStore) -mkStoreAccessor(SystemEventThreadIOManagerThreadStore) -mkStoreAccessor(SystemTimerThreadEventManagerStore) -mkStoreAccessor(SystemTimerThreadIOManagerThreadStore) -mkStoreAccessor(LibHSghcFastStringTable) -mkStoreAccessor(LibHSghcPersistentLinkerState) -mkStoreAccessor(LibHSghcInitLinkerDone) -mkStoreAccessor(LibHSghcGlobalDynFlags) -mkStoreAccessor(LibHSghcStaticOptions) -mkStoreAccessor(LibHSghcStaticOptionsReady) +StgStablePtr +getOrSetGHCConcSignalSignalHandlerStore(StgStablePtr ptr) +{ + return getOrSetKey(GHCConcSignalSignalHandlerStore,ptr); +} + +StgStablePtr +getOrSetGHCConcWindowsPendingDelaysStore(StgStablePtr ptr) +{ + return getOrSetKey(GHCConcWindowsPendingDelaysStore,ptr); +} + +StgStablePtr +getOrSetGHCConcWindowsIOManagerThreadStore(StgStablePtr ptr) +{ + return getOrSetKey(GHCConcWindowsIOManagerThreadStore,ptr); +} + +StgStablePtr +getOrSetGHCConcWindowsProddingStore(StgStablePtr ptr) +{ + return getOrSetKey(GHCConcWindowsProddingStore,ptr); +} + +StgStablePtr +getOrSetSystemEventThreadEventManagerStore(StgStablePtr ptr) +{ + return getOrSetKey(SystemEventThreadEventManagerStore,ptr); +} + +StgStablePtr +getOrSetSystemEventThreadIOManagerThreadStore(StgStablePtr ptr) +{ + return getOrSetKey(SystemEventThreadIOManagerThreadStore,ptr); +} + +StgStablePtr +getOrSetSystemTimerThreadEventManagerStore(StgStablePtr ptr) +{ + return getOrSetKey(SystemTimerThreadEventManagerStore,ptr); +} + +StgStablePtr +getOrSetSystemTimerThreadIOManagerThreadStore(StgStablePtr ptr) +{ + return getOrSetKey(SystemTimerThreadIOManagerThreadStore,ptr); +} + +StgStablePtr +getOrSetLibHSghcFastStringTable(StgStablePtr ptr) +{ + return getOrSetKey(LibHSghcFastStringTable,ptr); +} diff --git a/testsuite/tests/plugins/LinkerTicklingPlugin.hs b/testsuite/tests/plugins/LinkerTicklingPlugin.hs index 52d5e177bb..7ee63cd7a0 100644 --- a/testsuite/tests/plugins/LinkerTicklingPlugin.hs +++ b/testsuite/tests/plugins/LinkerTicklingPlugin.hs @@ -12,4 +12,6 @@ plugin = defaultPlugin { -- or a new instance of it. If it is a new instance the staticFlags -- won't have been initialised, so we'll get a GHC panic here: install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] -install _options todos = length staticFlags `seq` return todos +install _options todos = reinitializeGlobals >> (length staticFlags `seq` return todos) + --- XXX: remove reinitializeGlobals when we have fixed the linker + -- problem (see comment with reinitializeGlobals in CoreMonad.hs) diff --git a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs index 55e32e5b69..883ba3ada6 100644 --- a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs +++ b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs @@ -13,6 +13,7 @@ plugin = defaultPlugin { install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install _ todo = do + reinitializeGlobals return (CoreDoPluginPass "Say name" pass : todo) pass :: ModGuts -> CoreM ModGuts diff --git a/testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs b/testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs index e411d04e67..cb6a03d394 100644 --- a/testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs +++ b/testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs @@ -8,6 +8,7 @@ plugin = defaultPlugin { installCoreToDos = install } where install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install _ todos = do + reinitializeGlobals putMsgS "T7702Plugin" |