X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelMain.lhs;h=d484482242058c44b7561f07729a4af3b1c149ab;hb=14b9c05ff17f318b64b112040621e1513bd1def3;hp=6674dc3b96635f4269458e36b8c146c33280fa85;hpb=d9af408e5c512501cfa991f5e4a76c9154bca917;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelMain.lhs b/ghc/lib/std/PrelMain.lhs index 6674dc3..d484482 100644 --- a/ghc/lib/std/PrelMain.lhs +++ b/ghc/lib/std/PrelMain.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelMain.lhs,v 1.8 2001/05/18 16:54:05 simonmar Exp $ +% $Id: PrelMain.lhs,v 1.9 2001/05/21 14:07:31 simonmar Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -7,69 +7,16 @@ \section[PrelMain]{Module @PrelMain@} \begin{code} -module PrelMain( mainIO, reportStackOverflow, reportError ) where +module PrelMain( mainIO ) where -import Prelude import {-# SOURCE #-} qualified Main -- for type of "Main.main" import IO -import PrelCString -import PrelPtr import PrelException -\end{code} +import PrelTopHandler -\begin{code} mainIO :: IO () -- It must be of type (IO t) because that's what -- the RTS expects. GHC doesn't check this, so -- make sure this type signature stays! mainIO = catchException Main.main topHandler - --- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and --- PrelMain.mainIO) and report them - topHandler is the exception --- handler they should use for this: - --- make sure we handle errors while reporting the error! --- (e.g. evaluating the string passed to 'error' might generate --- another error, etc.) -topHandler :: Exception -> IO () -topHandler err = catchException (real_handler err) topHandler - -real_handler :: Exception -> IO () -real_handler ex = - case ex of - AsyncException StackOverflow -> reportStackOverflow True - ErrorCall s -> reportError True s - other -> reportError True (showsPrec 0 other "\n") - -reportStackOverflow :: Bool -> IO () -reportStackOverflow bombOut = do - (hFlush stdout) `catchException` (\ _ -> return ()) - callStackOverflowHook - if bombOut then - stg_exit 2 - else - return () - -reportError :: Bool -> String -> IO () -reportError bombOut str = do - (hFlush stdout) `catchException` (\ _ -> return ()) - withCStringLen str $ \(cstr,len) -> do - writeErrString addrOf_ErrorHdrHook cstr len - if bombOut - then stg_exit 1 - else return () - -foreign import ccall "addrOf_ErrorHdrHook" unsafe - addrOf_ErrorHdrHook :: Ptr () - -foreign import ccall "writeErrString__" unsafe - writeErrString :: Ptr () -> CString -> Int -> IO () - --- SUP: Are the hooks allowed to re-enter Haskell land? If so, remove --- the unsafe below. -foreign import ccall "stackOverflow" unsafe - callStackOverflowHook :: IO () - -foreign import ccall "stg_exit" unsafe - stg_exit :: Int -> IO () \end{code}