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