[project @ 2003-02-17 12:24:26 by simonmar]

Restore interrupt/quit signal handlers after every evaluation in GHCi,
just in case the program set its own.

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index e68c14b..a9b4f94 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.144 2003/02/13 01:50:04 sof Exp $
+-- $Id: InteractiveUI.hs,v 1.145 2003/02/17 12:24:26 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -41,7 +41,7 @@ import Packages
 import Outputable
 import CmdLineOpts     ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
                          restoreDynFlags, dopt_unset )
-import Panic           ( GhcException(..), showGhcException )
+import Panic           hiding ( showException )
 import Config
 
 #ifndef mingw32_TARGET_OS
@@ -355,6 +355,7 @@ runCommand c = ghciHandle handler (doCommand c)
 handler :: Exception -> GHCi Bool
 handler exception = do
   flushInterpBuffers
+  io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =
@@ -396,6 +397,7 @@ finishEvalExpr names
       when b (mapM_ (showTypeOfName cmstate) names)
 
       flushInterpBuffers
+      io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
       return True

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index abe7c01..457e946 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.118 2003/01/09 10:49:21 simonmar Exp $
+-- $Id: Main.hs,v 1.119 2003/02/17 12:24:27 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -56,30 +56,12 @@ import CmdLineOpts  ( dynFlag, restoreDynFlags,
 import BasicTypes      ( failed )
 import Outputable
 import Util
-import Panic           ( GhcException(..), panic )
+import Panic           ( GhcException(..), panic, installSignalHandlers )
 
 import DATA_IOREF      ( readIORef, writeIORef )
 import EXCEPTION       ( throwDyn, Exception(..), 
                          AsyncException(StackOverflow) )
 
-#ifndef mingw32_HOST_OS
-import CONCURRENT      ( myThreadId )
-# if __GLASGOW_HASKELL__ < 500
-import EXCEPTION        ( raiseInThread )
-#define throwTo  raiseInThread
-# else
-import EXCEPTION       ( throwTo )
-# endif
-
-#if __GLASGOW_HASKELL__ > 504
-import System.Posix.Signals
-#else
-import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
-#endif
-
-import DYNAMIC         ( toDyn )
-#endif
-
 -- Standard Haskell libraries
 import IO
 import Directory       ( doesFileExist )
@@ -145,14 +127,7 @@ main =
        -- so there shouldn't be any difficulty if we receive further
        -- signals.
 
-       -- install signal handlers
-#ifndef mingw32_HOST_OS
-   main_thread <- myThreadId
-   let sig_handler = Catch (throwTo main_thread 
-                               (DynException (toDyn Interrupted)))
-   installHandler sigQUIT sig_handler Nothing 
-   installHandler sigINT  sig_handler Nothing
-#endif
+   installSignalHandlers
 
    argv <- getArgs
    let (minusB_args, argv') = partition (prefixMatch "-B") argv

diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs
index 01d1568..152f2e7 100644 (file)
--- a/ghc/compiler/utils/Panic.lhs
+++ b/ghc/compiler/utils/Panic.lhs
@@ -14,6 +14,7 @@ module Panic
      GhcException(..), ghcError, progName, 
      panic, panic#, assertPanic, trace,
      showException, showGhcException, tryMost,
+     installSignalHandlers,
 
 #if __GLASGOW_HASKELL__ <= 408
      catchJust, ioErrors, throwTo,
@@ -25,6 +26,23 @@ module Panic
 import Config
 import FastTypes
 
+#if __GLASGOW_HASKELL__ > 504
+import System.Posix.Signals
+#else
+import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
+#endif
+
+#ifndef mingw32_HOST_OS
+import CONCURRENT      ( myThreadId )
+
+# if __GLASGOW_HASKELL__ < 500
+import EXCEPTION        ( raiseInThread )
+#define throwTo  raiseInThread
+# else
+import EXCEPTION       ( throwTo )
+# endif
+#endif
+
 import DYNAMIC
 import qualified EXCEPTION as Exception
 import TRACE           ( trace )
@@ -159,3 +177,20 @@ ioErrors  = Exception.justIoErrors
 throwTo   = Exception.raiseInThread
 #endif
 \end{code}
+
+Standard signal handlers for catching ^C, which just throw an
+exception in the main thread.  NOTE: must be called from the main
+thread.
+
+\begin{code}
+installSignalHandlers :: IO ()
+installSignalHandlers = do
+#ifndef mingw32_HOST_OS
+  main_thread <- myThreadId
+  let sig_handler = Catch (throwTo main_thread 
+                               (Exception.DynException (toDyn Interrupted)))
+  installHandler sigQUIT sig_handler Nothing 
+  installHandler sigINT  sig_handler Nothing
+#endif
+  return ()
+\end{code}