[commit: ghc] master: Stop the linker panic (4fc6524)
git at git.haskell.org
git at git.haskell.org
Mon Aug 6 22:29:55 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/4fc6524a2a4a0003495a96c8b84783286f65c198/ghc
>---------------------------------------------------------------
commit 4fc6524a2a4a0003495a96c8b84783286f65c198
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date: Mon Aug 6 12:46:26 2018 -0400
Stop the linker panic
If we fail to initialize the liker properly, we still set the
`initLinkerDone`. In fact we even set that prior to actually
initializing the linker. However if the linker initialization fails, we
the `Done` state is still true. As such we run into the `Dynamic Linker
not initialised` error. Which while technically corret is confusing as
it pulls the attation away from the real issue.
This change puts the Done state into an MVar, and as such ensureing
that all parallel access needs to wait for the linker to be actually
initialized, or try to re-initilize if it fails.
Reviewers: bgamari, RyanGlScott, simonmar, hvr
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #9868, #10355, #13137, #13607, #13531
Differential Revision: https://phabricator.haskell.org/D5012
>---------------------------------------------------------------
4fc6524a2a4a0003495a96c8b84783286f65c198
compiler/ghci/Linker.hs | 59 ++++++++++++++++++++++++++++---------------------
compiler/utils/Panic.hs | 13 +++++++++++
2 files changed, 47 insertions(+), 25 deletions(-)
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 286cd0d..9f1307d 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -87,35 +87,45 @@ import Foreign (Ptr)
The persistent linker state *must* match the actual state of the
C dynamic linker at all times, so we keep it in a private global variable.
-The global IORef used for PersistentLinkerState actually contains another MVar.
-The reason for this is that we want to allow another loaded copy of the GHC
-library to side-effect the PLS and for those changes to be reflected here.
+The global IORef used for PersistentLinkerState actually contains another MVar,
+which in turn contains a Maybe PersistentLinkerState. The MVar serves to ensure
+mutual exclusion between multiple loaded copies of the GHC library. The Maybe
+may be Nothing to indicate that the linker has not yet been initialised.
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
+GLOBAL_VAR_M( v_PersistentLinkerState
+ , newMVar Nothing
+ , MVar (Maybe PersistentLinkerState))
#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)
+ , newMVar Nothing
+ , MVar (Maybe PersistentLinkerState))
#endif
+uninitialised :: a
+uninitialised = panic "Dynamic linker not initialised"
+
modifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO ()
-modifyPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f
+modifyPLS_ f = readIORef v_PersistentLinkerState
+ >>= flip modifyMVar_ (fmap pure . f . fromMaybe uninitialised)
modifyPLS :: (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a
-modifyPLS f = readIORef v_PersistentLinkerState >>= flip modifyMVar f
+modifyPLS f = readIORef v_PersistentLinkerState
+ >>= flip modifyMVar (fmapFst pure . f . fromMaybe uninitialised)
+ where fmapFst f = fmap (\(x, y) -> (f x, y))
+
+readPLS :: IO PersistentLinkerState
+readPLS = readIORef v_PersistentLinkerState
+ >>= fmap (fromMaybe uninitialised) . readMVar
+
+modifyMbPLS_
+ :: (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO ()
+modifyMbPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f
data PersistentLinkerState
= PersistentLinkerState {
@@ -255,7 +265,7 @@ withExtendedLinkEnv new_env action
-- | Display the persistent linker state.
showLinkerState :: DynFlags -> IO ()
showLinkerState dflags
- = do pls <- readIORef v_PersistentLinkerState >>= readMVar
+ = do pls <- readPLS
putLogMsg dflags NoReason SevDump noSrcSpan
(defaultDumpStyle dflags)
(vcat [text "----- Linker state -----",
@@ -290,11 +300,10 @@ showLinkerState dflags
--
initDynLinker :: HscEnv -> IO ()
initDynLinker hsc_env =
- modifyPLS_ $ \pls0 -> do
- done <- readIORef v_InitLinkerDone
- if done then return pls0
- else do writeIORef v_InitLinkerDone True
- reallyInitDynLinker hsc_env
+ modifyMbPLS_ $ \pls -> do
+ case pls of
+ Just _ -> return pls
+ Nothing -> Just <$> reallyInitDynLinker hsc_env
reallyInitDynLinker :: HscEnv -> IO PersistentLinkerState
reallyInitDynLinker hsc_env = do
@@ -1338,8 +1347,8 @@ load_dyn hsc_env dll = do
r <- loadDLL hsc_env dll
case r of
Nothing -> return ()
- Just err -> throwGhcExceptionIO (CmdLineError ("can't load .so/.DLL for: "
- ++ dll ++ " (" ++ err ++ ")" ))
+ Just err -> cmdLineErrorIO ("can't load .so/.DLL for: "
+ ++ dll ++ " (" ++ err ++ ")")
loadFrameworks :: HscEnv -> Platform -> PackageConfig -> IO ()
loadFrameworks hsc_env platform pkg
@@ -1351,8 +1360,8 @@ loadFrameworks hsc_env platform pkg
load fw = do r <- loadFramework hsc_env fw_dirs fw
case r of
Nothing -> return ()
- Just err -> throwGhcExceptionIO (CmdLineError ("can't load framework: "
- ++ fw ++ " (" ++ err ++ ")" ))
+ Just err -> cmdLineErrorIO ("can't load framework: "
+ ++ fw ++ " (" ++ err ++ ")" )
-- Try to find an object file for a given library in the given paths.
-- If it isn't present, we assume that addDLL in the RTS can find it,
diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs
index ebf8303..03f095b 100644
--- a/compiler/utils/Panic.hs
+++ b/compiler/utils/Panic.hs
@@ -20,6 +20,8 @@ module Panic (
panic, sorry, assertPanic, trace,
panicDoc, sorryDoc, pgmErrorDoc,
+ cmdLineError, cmdLineErrorIO,
+
Exception.Exception(..), showException, safeShowException,
try, tryMost, throwTo,
@@ -195,6 +197,17 @@ panicDoc x doc = throwGhcException (PprPanic x doc)
sorryDoc x doc = throwGhcException (PprSorry x doc)
pgmErrorDoc x doc = throwGhcException (PprProgramError x doc)
+cmdLineError :: String -> a
+cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO
+
+cmdLineErrorIO :: String -> IO a
+cmdLineErrorIO x = do
+ stack <- ccsToStrings =<< getCurrentCCS x
+ if null stack
+ then throwGhcException (CmdLineError x)
+ else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack))
+
+
-- | Throw a failed assertion exception for a given filename and line number.
assertPanic :: String -> Int -> a
More information about the ghc-commits
mailing list