adding FastString.string_table to the sharedCAF/Globals.c mechanism

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 2475247..31547e1 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)                                       \