Commit 35e3e024 authored by simonmar's avatar simonmar
Browse files

[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.
parent ce25c4af
{-# OPTIONS -#include "Linker.h" #-} {-# 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 -- GHC Interactive User Interface
-- --
...@@ -41,7 +41,7 @@ import Packages ...@@ -41,7 +41,7 @@ import Packages
import Outputable import Outputable
import CmdLineOpts ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags, import CmdLineOpts ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
restoreDynFlags, dopt_unset ) restoreDynFlags, dopt_unset )
import Panic ( GhcException(..), showGhcException ) import Panic hiding ( showException )
import Config import Config
#ifndef mingw32_TARGET_OS #ifndef mingw32_TARGET_OS
...@@ -355,6 +355,7 @@ runCommand c = ghciHandle handler (doCommand c) ...@@ -355,6 +355,7 @@ runCommand c = ghciHandle handler (doCommand c)
handler :: Exception -> GHCi Bool handler :: Exception -> GHCi Bool
handler exception = do handler exception = do
flushInterpBuffers flushInterpBuffers
io installSignalHandlers
ghciHandle handler (showException exception >> return False) ghciHandle handler (showException exception >> return False)
showException (DynException dyn) = showException (DynException dyn) =
...@@ -396,6 +397,7 @@ finishEvalExpr names ...@@ -396,6 +397,7 @@ finishEvalExpr names
when b (mapM_ (showTypeOfName cmstate) names) when b (mapM_ (showTypeOfName cmstate) names)
flushInterpBuffers flushInterpBuffers
io installSignalHandlers
b <- isOptionSet RevertCAFs b <- isOptionSet RevertCAFs
io (when b revertCAFs) io (when b revertCAFs)
return True return True
......
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} {-# 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 -- GHC Driver program
-- --
...@@ -56,30 +56,12 @@ import CmdLineOpts ( dynFlag, restoreDynFlags, ...@@ -56,30 +56,12 @@ import CmdLineOpts ( dynFlag, restoreDynFlags,
import BasicTypes ( failed ) import BasicTypes ( failed )
import Outputable import Outputable
import Util import Util
import Panic ( GhcException(..), panic ) import Panic ( GhcException(..), panic, installSignalHandlers )
import DATA_IOREF ( readIORef, writeIORef ) import DATA_IOREF ( readIORef, writeIORef )
import EXCEPTION ( throwDyn, Exception(..), import EXCEPTION ( throwDyn, Exception(..),
AsyncException(StackOverflow) ) 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 -- Standard Haskell libraries
import IO import IO
import Directory ( doesFileExist ) import Directory ( doesFileExist )
...@@ -145,14 +127,7 @@ main = ...@@ -145,14 +127,7 @@ main =
-- so there shouldn't be any difficulty if we receive further -- so there shouldn't be any difficulty if we receive further
-- signals. -- signals.
-- install signal handlers installSignalHandlers
#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
argv <- getArgs argv <- getArgs
let (minusB_args, argv') = partition (prefixMatch "-B") argv let (minusB_args, argv') = partition (prefixMatch "-B") argv
......
...@@ -14,6 +14,7 @@ module Panic ...@@ -14,6 +14,7 @@ module Panic
GhcException(..), ghcError, progName, GhcException(..), ghcError, progName,
panic, panic#, assertPanic, trace, panic, panic#, assertPanic, trace,
showException, showGhcException, tryMost, showException, showGhcException, tryMost,
installSignalHandlers,
#if __GLASGOW_HASKELL__ <= 408 #if __GLASGOW_HASKELL__ <= 408
catchJust, ioErrors, throwTo, catchJust, ioErrors, throwTo,
...@@ -25,6 +26,23 @@ module Panic ...@@ -25,6 +26,23 @@ module Panic
import Config import Config
import FastTypes 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 DYNAMIC
import qualified EXCEPTION as Exception import qualified EXCEPTION as Exception
import TRACE ( trace ) import TRACE ( trace )
...@@ -159,3 +177,20 @@ ioErrors = Exception.justIoErrors ...@@ -159,3 +177,20 @@ ioErrors = Exception.justIoErrors
throwTo = Exception.raiseInThread throwTo = Exception.raiseInThread
#endif #endif
\end{code} \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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment