[commit: ghc] master: adding FastString.string_table to the sharedCAF/Globals.c mechanism (193e0ee)
Nicolas Frisby
nifr at ghc.haskell.org
Tue Jul 16 21:31:45 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/193e0ee9aa8705dcc0020eaaf6bfb6714db6f9ca
>---------------------------------------------------------------
commit 193e0ee9aa8705dcc0020eaaf6bfb6714db6f9ca
Author: Nicolas Frisby <nicolas.frisby at gmail.com>
Date: Wed Jul 10 12:55:08 2013 -0500
adding FastString.string_table to the sharedCAF/Globals.c mechanism
>---------------------------------------------------------------
compiler/simplCore/CoreMonad.lhs | 8 +++++
compiler/utils/FastString.lhs | 67 ++++++++++++++++++++++++++++++++++----
includes/rts/Globals.h | 1 +
rts/Globals.c | 16 +++++++--
rts/Linker.c | 1 +
5 files changed, 84 insertions(+), 9 deletions(-)
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 2475247..31547e1 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -903,6 +903,14 @@ 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.
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 36b1b1e..25f9802 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -120,6 +120,10 @@ import GHC.IO ( IO(..) )
import Foreign.Safe
+#if STAGE >= 2
+import GHC.Conc.Sync (sharedCAF)
+#endif
+
#if defined(__GLASGOW_HASKELL__)
import GHC.Base ( unpackCString# )
#endif
@@ -225,14 +229,63 @@ data FastStringTable =
{-# UNPACK #-} !Int
(MutableArray# RealWorld [FastString])
-{-# NOINLINE string_table #-}
string_table :: IORef FastStringTable
-string_table =
- unsafePerformIO $ do
- tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
- (# s2#, arr# #) ->
- (# s2#, FastStringTable 0 arr# #)
- newIORef tab
+{-# NOINLINE string_table #-}
+string_table = unsafePerformIO $ do
+ tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
+ (# s2#, arr# #) ->
+ (# s2#, FastStringTable 0 arr# #)
+ ref <- newIORef tab
+ -- use the support wired into the RTS to share this CAF among all images of
+ -- libHSghc
+#if STAGE < 2
+ return ref
+#else
+ sharedCAF ref getOrSetLibHSghcFastStringTable
+
+-- from the RTS; thus we cannot use this mechanism when STAGE<2; the previous
+-- RTS might not have this symbol
+foreign import ccall unsafe "getOrSetLibHSghcFastStringTable"
+ getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a)
+#endif
+
+{-
+
+We include the FastString table in the `sharedCAF` mechanism because we'd like
+FastStrings created by a Core plugin to have the same uniques as corresponding
+strings created by the host compiler itself. For example, this allows plugins
+to lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or
+even re-invoke the parser.
+
+In particular, the following little sanity test was failing in a plugin
+prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not
+be looked up /by the plugin/.
+
+ let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
+ putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts
+
+`mkTcOcc` involves the lookup (or creation) of a FastString. Since the
+plugin's FastString.string_table is empty, constructing the RdrName also
+allocates new uniques for the FastStrings "GHC.NT.Type" and "NT". These
+uniques are almost certainly unequal to the ones that the host compiler
+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
+FastStrings with the same unique have the same string. Thus we use the
+lower-level `sharedCAF` mechanism that relies on Globals.c.
+
+-}
lookupTbl :: FastStringTable -> Int -> IO [FastString]
lookupTbl (FastStringTable _ arr#) (I# i#) =
diff --git a/includes/rts/Globals.h b/includes/rts/Globals.h
index 720d967..d0d34ef 100644
--- a/includes/rts/Globals.h
+++ b/includes/rts/Globals.h
@@ -25,5 +25,6 @@ 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/rts/Globals.c b/rts/Globals.c
index 1aafe21..2e4b994 100644
--- a/rts/Globals.c
+++ b/rts/Globals.c
@@ -7,8 +7,13 @@
* even when multiple versions of the library are loaded. e.g. see
* Data.Typeable and GHC.Conc.
*
- * If/when we switch to a dynamically-linked GHCi, this can all go
- * away, because there would be just one copy of each library.
+ * How are multiple versions of a library loaded? Examples:
+ *
+ * base - a statically-linked ghci has its own copy, so might libraries it
+ * dynamically loads
+ *
+ * libHSghc - a statically-linked ghc has its own copy and so will Core
+ * plugins it dynamically loads (cf CoreMonad.reinitializeGlobals)
*
* ---------------------------------------------------------------------------*/
@@ -27,6 +32,7 @@ typedef enum {
SystemEventThreadIOManagerThreadStore,
SystemTimerThreadEventManagerStore,
SystemTimerThreadIOManagerThreadStore,
+ LibHSghcFastStringTable,
MaxStoreKey
} StoreKey;
@@ -128,3 +134,9 @@ getOrSetSystemTimerThreadIOManagerThreadStore(StgStablePtr ptr)
{
return getOrSetKey(SystemTimerThreadIOManagerThreadStore,ptr);
}
+
+StgStablePtr
+getOrSetLibHSghcFastStringTable(StgStablePtr ptr)
+{
+ return getOrSetKey(LibHSghcFastStringTable,ptr);
+}
diff --git a/rts/Linker.c b/rts/Linker.c
index 08069cf..0c7dfd2 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1106,6 +1106,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
SymI_HasProto(getOrSetSystemTimerThreadEventManagerStore) \
SymI_HasProto(getOrSetSystemTimerThreadIOManagerThreadStore) \
+ SymI_HasProto(getOrSetLibHSghcFastStringTable) \
SymI_HasProto(getGCStats) \
SymI_HasProto(getGCStatsEnabled) \
SymI_HasProto(genericRaise) \
More information about the ghc-commits
mailing list