1 -- -----------------------------------------------------------------------------
2 -- $Id: TopHandler.lhs,v 1.6 2002/03/11 14:53:51 simonmar Exp $
4 -- (c) The University of Glasgow, 2001
8 -- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
9 -- GHC.Main.mainIO) and report them - topHandler is the exception
10 -- handler they should use for this:
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.)
16 -- These functions can't go in GHC.Main, because GHC.Main isn't
17 -- included in HSstd.o (because GHC.Main depends on Main, which
18 -- doesn't exist yet...).
21 module GHC.TopHandler (
22 runMain, reportStackOverflow, reportError
29 import Foreign.C.String
34 -- runMain is applied to Main.main by TcModule
35 runMain :: IO a -> IO ()
36 runMain main = catchException (main >> return ()) topHandler
38 topHandler :: Exception -> IO ()
39 topHandler err = catchException (real_handler err) topHandler
41 real_handler :: Exception -> IO ()
44 AsyncException StackOverflow -> reportStackOverflow True
46 -- only the main thread gets ExitException exceptions
47 ExitException ExitSuccess -> shutdownHaskellAndExit 0
48 ExitException (ExitFailure n) -> shutdownHaskellAndExit n
50 Deadlock -> reportError True
51 "no threads to run: infinite loop or deadlock?"
53 ErrorCall s -> reportError True s
54 other -> reportError True (showsPrec 0 other "\n")
56 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
57 -- re-enter Haskell land through finalizers.
58 foreign import ccall "shutdownHaskellAndExit"
59 shutdownHaskellAndExit :: Int -> IO ()
61 reportStackOverflow :: Bool -> IO ()
62 reportStackOverflow bombOut = do
63 (hFlush stdout) `catchException` (\ _ -> return ())
70 reportError :: Bool -> String -> IO ()
71 reportError bombOut str = do
72 (hFlush stdout) `catchException` (\ _ -> return ())
73 withCStringLen str $ \(cstr,len) -> do
74 writeErrString errorHdrHook cstr len
80 foreign import ccall "&ErrorHdrHook" errorHdrHook :: Ptr ()
82 foreign import ccall "ErrorHdrHook" errorHdrHook :: Ptr ()
85 foreign import ccall unsafe "writeErrString__"
86 writeErrString :: Ptr () -> CString -> Int -> IO ()
88 -- SUP: Are the hooks allowed to re-enter Haskell land? If so, remove
90 foreign import ccall unsafe "stackOverflow"
91 callStackOverflowHook :: IO ()
93 foreign import ccall unsafe "stg_exit"
94 stg_exit :: Int -> IO ()