[commit: ghc] ghc-parmake-gsoc: TcEnv: Make mkWrapperName deterministic and thread-safe (db34794)

git at git.haskell.org git at git.haskell.org
Tue Aug 27 16:11:47 CEST 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-parmake-gsoc
Link       : http://ghc.haskell.org/trac/ghc/changeset/db347943b860b7bede85fe4a94f0e79eada035ae/ghc

>---------------------------------------------------------------

commit db347943b860b7bede85fe4a94f0e79eada035ae
Author: Patrick Palka <patrick at parcs.ath.cx>
Date:   Wed Aug 21 17:31:40 2013 -0400

    TcEnv: Make mkWrapperName deterministic and thread-safe


>---------------------------------------------------------------

db347943b860b7bede85fe4a94f0e79eada035ae
 compiler/main/DynFlags.hs    |    4 ++--
 compiler/typecheck/TcEnv.lhs |    9 +++++++--
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index e69cccb..cb7d43c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -748,7 +748,7 @@ data DynFlags = DynFlags {
 
   llvmVersion           :: IORef Int,
 
-  nextWrapperNum        :: IORef Int,
+  nextWrapperNum        :: IORef (ModuleEnv Int),
 
   -- | Machine dependant flags (-m<blah> stuff)
   sseVersion            :: Maybe (Int, Int),  -- (major, minor)
@@ -1211,7 +1211,7 @@ initDynFlags dflags = do
  refGeneratedDumps <- newIORef Set.empty
  refLlvmVersion <- newIORef 28
  refRtldFlags <- newIORef Nothing
- wrapperNum <- newIORef 0
+ wrapperNum <- newIORef emptyModuleEnv
  canUseUnicodeQuotes <- do let enc = localeEncoding
                                str = "‛’"
                            (withCString enc str $ \cstr ->
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 058e84a..dde9797 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -781,8 +781,10 @@ mkWrapperName what nameBase
              wrapperRef = nextWrapperNum dflags
              pkg = packageIdString  (modulePackageId thisMod)
              mod = moduleNameString (moduleName      thisMod)
-         wrapperNum <- liftIO $ readIORef wrapperRef
-         liftIO $ writeIORef wrapperRef (wrapperNum + 1)
+         wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env ->
+             let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
+                 mod_env' = extendModuleEnv mod_env thisMod (num+1)
+             in (mod_env', num)
          let components = [what, show wrapperNum, pkg, mod, nameBase]
          return $ mkFastString $ zEncodeString $ intercalate ":" components
 
@@ -795,6 +797,9 @@ generate are external names. This means that if a call to them ends up
 in an unfolding, then we can't alpha-rename them, and thus if the
 unique randomly changes from one compile to another then we get a
 spurious ABI change (#4012).
+
+The wrapper counter has to be per-module, not global, so that the number we end
+up using is not dependent on the modules compiled before the current one.
 -}
 \end{code}
 





More information about the ghc-commits mailing list