From: simonmar <unknown>
Date: Mon, 17 Feb 2003 12:24:28 +0000 (+0000)
Subject: [project @ 2003-02-17 12:24:26 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~1155
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=35e3e0244c957a694dcd24564a9c774f42e84647;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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}