ghc/lib/std/PrelTopHandler.hs

   1 {-# OPTIONS -#include "PrelIOUtils.h" #-}
   2 -- -----------------------------------------------------------------------------
   3 --
   4 -- (c) The University of Glasgow, 1994-2002
   5 --
   6 -- PrelTopHandler
   7 --
   8 -- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
   9 -- PrelMain.mainIO) and report them - topHandler is the exception
  10 -- handler they should use for this:
  11
  12 -- make sure we handle errors while reporting the error!
  13 -- (e.g. evaluating the string passed to 'error' might generate
  14 --  another error, etc.)
  15
  16 -- These functions can't go in PrelMain, because PrelMain isn't
  17 -- included in HSstd.o (because PrelMain depends on Main, which
  18 -- doesn't exist yet...).
  19 --
  20 -- Note: used to be called PrelTopHandler.lhs, so if you're looking
  21 --       for CVS info, try 'cvs log'ging it too.
  22 module PrelTopHandler (
  23    runMain, reportStackOverflow, reportError
  24   ) where
  25
  26 import IO
  27
  28 import PrelCString
  29 import PrelPtr
  30 import PrelIOBase
  31 import PrelException
  32
  33 -- runMain is applied to Main.main by TcModule
  34 runMain :: IO a -> IO ()
  35 runMain main = catchException (main >> return ()) topHandler
  36
  37 topHandler :: Exception -> IO ()
  38 topHandler err = catchException (real_handler err) topHandler
  39
  40 real_handler :: Exception -> IO ()
  41 real_handler ex =
  42   case ex of
  43         AsyncException StackOverflow -> reportStackOverflow True
  44
  45         -- only the main thread gets ExitException exceptions
  46         ExitException ExitSuccess     -> shutdownHaskellAndExit 0
  47         ExitException (ExitFailure n) -> shutdownHaskellAndExit n
  48
  49         Deadlock    -> reportError True
  50                           "no threads to run:  infinite loop or deadlock?"
  51
  52         ErrorCall s -> reportError True s
  53         other       -> reportError True (showsPrec 0 other "\n")
  54
  55 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
  56 -- re-enter Haskell land through finalizers.
  57 foreign import ccall "shutdownHaskellAndExit"
  58   shutdownHaskellAndExit :: Int -> IO ()
  59
  60 reportStackOverflow :: Bool -> IO ()
  61 reportStackOverflow bombOut = do
  62    (hFlush stdout) `catchException` (\ _ -> return ())
  63    callStackOverflowHook
  64    if bombOut then
  65      stg_exit 2
  66     else
  67      return ()
  68
  69 reportError :: Bool -> String -> IO ()
  70 reportError bombOut str = do
  71    (hFlush stdout) `catchException` (\ _ -> return ())
  72    withCStringLen str $ \(cstr,len) -> do
  73      writeErrString errorHdrHook cstr len
  74      if bombOut
  75         then stg_exit 1
  76         else return ()
  77
  78 #ifndef ILX
  79 foreign label "ErrorHdrHook" errorHdrHook :: Ptr ()
  80 #else
  81 foreign import "_ErrorHdrHook" errorHdrHook :: Ptr ()
  82 #endif
  83
  84 foreign import ccall "writeErrString__" unsafe
  85         writeErrString :: Ptr () -> CString -> Int -> IO ()
  86
  87 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  88 -- the unsafe below.
  89 foreign import ccall "stackOverflow" unsafe
  90         callStackOverflowHook :: IO ()
  91
  92 foreign import ccall "stg_exit" unsafe
  93         stg_exit :: Int -> IO ()
  94