Commit 35e3e024 authored by simonmar's avatar simonmar

[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" #-}
-----------------------------------------------------------------------------
-- $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
......
{-# 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
......
......@@ -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}
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