GHC/TopHandler.lhs

   1 \begin{code}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  GHC.TopHandler
   5 -- Copyright   :  (c) The University of Glasgow, 2001-2002
   6 -- License     :  see libraries/base/LICENSE
   7 --
   8 -- Maintainer  :  cvs-ghc@haskell.org
   9 -- Stability   :  internal
  10 -- Portability :  non-portable (GHC Extensions)
  11 --
  12 -- Top-level IO actions want to catch exceptions (e.g., 'forkIO' and
  13 -- 'GHC.Main.mainIO') and report them - 'topHandler' is the exception
  14 -- handler they should use for this.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module GHC.TopHandler (
  19    runIO, runNonIO, reportStackOverflow, reportError
  20   ) where
  21
  22 import Prelude
  23
  24 import System.IO
  25
  26 import Foreign.C.String
  27 import Foreign.Ptr
  28 import GHC.IOBase
  29 import GHC.Exception
  30 import GHC.Prim (unsafeCoerce#)
  31
  32 -- | 'runIO' is wrapped around 'Main.main' by @TcModule@.  It is also wrapped
  33 -- around every @foreign export@ and @foreign import \"wrapper\"@ to mop up
  34 -- any uncaught exceptions.  Thus, the result of running
  35 -- 'System.Exit.exitWith' in a foreign-exported function is the same as
  36 -- in the main thread: it terminates the program.
  37 --
  38 runIO :: IO a -> IO a
  39 runIO main = catchException main topHandler
  40
  41 -- | The same as 'runIO', but for non-IO computations.  Used for
  42 -- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these
  43 -- are used to export Haskell functions with non-IO types.
  44 --
  45 runNonIO :: a -> IO a
  46 runNonIO a = catchException (a `seq` return a) topHandler
  47
  48 topHandler :: Exception -> IO a
  49 topHandler err = catchException (real_handler err) topHandler
  50
  51 -- Make sure we handle errors while reporting the error!
  52 -- (e.g. evaluating the string passed to 'error' might generate
  53 --  another error, etc.)
  54 --
  55 real_handler :: Exception -> IO a
  56 real_handler ex =
  57   case ex of
  58         AsyncException StackOverflow -> reportStackOverflow True
  59
  60         -- only the main thread gets ExitException exceptions
  61         ExitException ExitSuccess     -> safe_exit 0
  62         ExitException (ExitFailure n) -> safe_exit n
  63
  64         Deadlock    -> reportError True
  65                         "no threads to run:  infinite loop or deadlock?"
  66
  67         ErrorCall s -> reportError True s
  68         other       -> reportError True (showsPrec 0 other "\n")
  69
  70 reportStackOverflow :: Bool -> IO a
  71 reportStackOverflow bombOut = do
  72    (hFlush stdout) `catchException` (\ _ -> return ())
  73    callStackOverflowHook
  74    if bombOut
  75         then exit 2
  76         else return undefined
  77
  78 reportError :: Bool -> String -> IO a
  79 reportError bombOut str = do
  80    (hFlush stdout) `catchException` (\ _ -> return ())
  81    withCStringLen str $ \(cstr,len) -> do
  82      writeErrString errorHdrHook cstr len
  83      if bombOut
  84         then exit 1
  85         else return undefined
  86
  87 #ifndef ILX
  88 foreign import ccall "&ErrorHdrHook" errorHdrHook :: Ptr ()
  89 #else
  90 foreign import ccall "ErrorHdrHook" errorHdrHook :: Ptr ()
  91 #endif
  92
  93 foreign import ccall unsafe "writeErrString__"
  94         writeErrString :: Ptr () -> CString -> Int -> IO ()
  95
  96 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  97 -- the unsafe below.
  98 foreign import ccall unsafe "stackOverflow"
  99         callStackOverflowHook :: IO ()
 100
 101 foreign import ccall unsafe "stg_exit"
 102         stg_exit :: Int -> IO ()
 103
 104 exit :: Int -> IO a
 105 exit r = unsafeCoerce# (stg_exit r)
 106
 107 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 108 -- re-enter Haskell land through finalizers.
 109 foreign import ccall "shutdownHaskellAndExit"
 110   shutdownHaskellAndExit :: Int -> IO ()
 111
 112 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
 113 -- compiler doesn't let us declare that as the result type of a foreign export.
 114 safe_exit :: Int -> IO a
 115 safe_exit r = unsafeCoerce# (shutdownHaskellAndExit r)
 116 \end{code}