From: simonmar <unknown>
Date: Fri, 21 Jan 2005 16:02:48 +0000 (+0000)
Subject: [project @ 2005-01-21 16:02:47 by simonmar]
X-Git-Tag: nhc98-1-18-release~87
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6c764c914959c1d85a6d764184e8135f6f808196;p=haskell-directory.git

[project @ 2005-01-21 16:02:47 by simonmar]
Don't try to run finalizers at program exit.  This turned out to be
hard if not impossible to do in general, so now we don't attempt it at
all.

The Main.main wrapper, previously called runIO and now called
runMainIO, flushes stdout and stderr before exiting.  This should
catch most cases where programs rely on Handles being flushed at
program exit, but note that now if you simply drop a Handle in your
program, there's no guarantee it'll be flushed on exit.  If the
punters complain enough, I suppose we could implement a global
Handle table and flush them all at exit... I'd rather not do this if
possible, though.  Better to teach people to close their Handles
properly.
---

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 3b7f784..8df665e 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -230,8 +230,8 @@ real_handler ex =
 	AsyncException ThreadKilled  -> return ()
 
 	-- report all others:
-	AsyncException StackOverflow -> reportStackOverflow False
-	other       -> reportError False other
+	AsyncException StackOverflow -> reportStackOverflow
+	other       -> reportError other
 
 #endif /* __GLASGOW_HASKELL__ */
 
diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 8c123a2..186fd8e 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -15,7 +15,7 @@
 -----------------------------------------------------------------------------
 
 module GHC.TopHandler (
-   runIO, runNonIO, reportStackOverflow, reportError
+   runMainIO, runIO, runNonIO, reportStackOverflow, reportError
   ) where
 
 import Prelude
@@ -23,17 +23,21 @@ import Prelude
 import System.IO
 import Control.Exception
 
-import Foreign.C.String
-import Foreign.Ptr
 import GHC.IOBase
 import GHC.Exception
 import GHC.Prim (unsafeCoerce#)
 
--- | 'runIO' is wrapped around @Main.main@ by @TcModule@.  It is also wrapped
--- around every @foreign export@ and @foreign import \"wrapper\"@ to mop up
--- any uncaught exceptions.  Thus, the result of running
--- 'System.Exit.exitWith' in a foreign-exported function is the same as
--- in the main thread: it terminates the program.
+-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
+-- called in the program).  It catches otherwise uncaught exceptions,
+-- and also flushes stdout/stderr before exiting.
+runMainIO :: IO a -> IO a
+runMainIO main = (do a <- main; cleanUp; return a) `catchException` topHandler
+
+-- | 'runIO' is wrapped around every @foreign export@ and @foreign
+-- import \"wrapper\"@ to mop up any uncaught exceptions.  Thus, the
+-- result of running 'System.Exit.exitWith' in a foreign-exported
+-- function is the same as in the main thread: it terminates the
+-- program.
 --
 runIO :: IO a -> IO a
 runIO main = catchException main topHandler
@@ -55,49 +59,51 @@ topHandler err = catchException (real_handler err) topHandler
 real_handler :: Exception -> IO a
 real_handler ex =
   case ex of
-	AsyncException StackOverflow -> reportStackOverflow True
+	AsyncException StackOverflow -> do
+	   reportStackOverflow
+	   safeExit 2
 
 	-- only the main thread gets ExitException exceptions
-	ExitException ExitSuccess     -> safe_exit 0
-	ExitException (ExitFailure n) -> safe_exit n
+	ExitException ExitSuccess     -> safeExit 0
+	ExitException (ExitFailure n) -> safeExit n
 
-	other       -> reportError True other
+	other -> do
+	   reportError other
+	   safeExit 1
 	   
 
-reportStackOverflow :: Bool -> IO a
-reportStackOverflow bombOut = do
-   (hFlush stdout) `catchException` (\ _ -> return ())
-   callStackOverflowHook
-   if bombOut 
-	then exit 2
-	else return undefined
+reportStackOverflow :: IO a
+reportStackOverflow = do callStackOverflowHook; return undefined
 
-reportError :: Bool -> Exception -> IO a
-reportError bombOut ex = do
+reportError :: Exception -> IO a
+reportError ex = do
    handler <- getUncaughtExceptionHandler
    handler ex
-   if bombOut
-      then exit 1
-      else return undefined
+   return undefined
 
 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
 -- the unsafe below.
 foreign import ccall unsafe "stackOverflow"
 	callStackOverflowHook :: IO ()
 
-foreign import ccall unsafe "stg_exit"
-	stg_exit :: Int -> IO ()
+-- try to flush stdout/stderr, but don't worry if we fail
+-- (these handles might have errors, and we don't want to go into
+-- an infinite loop).
+cleanUp :: IO ()
+cleanUp = do
+  hFlush stdout `catchException` \_ -> return ()
+  hFlush stderr `catchException` \_ -> return ()
 
-exit :: Int -> IO a
-exit r = unsafeCoerce# (stg_exit r)
+cleanUpAndExit :: Int -> IO a
+cleanUpAndExit r = do cleanUp; safeExit r
+
+-- we have to use unsafeCoerce# to get the 'IO a' result type, since the
+-- compiler doesn't let us declare that as the result type of a foreign export.
+safeExit :: Int -> IO a
+safeExit r = unsafeCoerce# (shutdownHaskellAndExit r)
 
 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 -- re-enter Haskell land through finalizers.
 foreign import ccall "shutdownHaskellAndExit" 
   shutdownHaskellAndExit :: Int -> IO ()
-
--- we have to use unsafeCoerce# to get the 'IO a' result type, since the
--- compiler doesn't let us declare that as the result type of a foreign export.
-safe_exit :: Int -> IO a
-safe_exit r = unsafeCoerce# (shutdownHaskellAndExit r)
 \end{code}