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

1 files changed, 13 insertions, 0 deletions

diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs
index ebf830385c..03f095b1a0 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