import Prelude -- necessary to get dependencies right
-#ifdef __GLASGOW_HASKELL__
-#include "Signals.h"
-#endif
-
import Foreign
import Foreign.C
import System.IO.Unsafe
#ifndef mingw32_HOST_OS
-- WHOLE FILE...
+#ifdef __GLASGOW_HASKELL__
+#include "Signals.h"
+import GHC.Conc ( ensureIOManagerIsRunning )
+#endif
+
-- -----------------------------------------------------------------------------
-- Specific signals
nullSignal :: Signal
nullSignal = 0
-sigABRT = CONST_SIGABRT :: CInt
-sigALRM = CONST_SIGALRM :: CInt
-sigBUS = CONST_SIGBUS :: CInt
-sigCHLD = CONST_SIGCHLD :: CInt
-sigCONT = CONST_SIGCONT :: CInt
-sigFPE = CONST_SIGFPE :: CInt
-sigHUP = CONST_SIGHUP :: CInt
-sigILL = CONST_SIGILL :: CInt
-sigINT = CONST_SIGINT :: CInt
-sigKILL = CONST_SIGKILL :: CInt
-sigPIPE = CONST_SIGPIPE :: CInt
-sigQUIT = CONST_SIGQUIT :: CInt
-sigSEGV = CONST_SIGSEGV :: CInt
-sigSTOP = CONST_SIGSTOP :: CInt
-sigTERM = CONST_SIGTERM :: CInt
-sigTSTP = CONST_SIGTSTP :: CInt
-sigTTIN = CONST_SIGTTIN :: CInt
-sigTTOU = CONST_SIGTTOU :: CInt
-sigUSR1 = CONST_SIGUSR1 :: CInt
-sigUSR2 = CONST_SIGUSR2 :: CInt
-sigPOLL = CONST_SIGPOLL :: CInt
-sigPROF = CONST_SIGPROF :: CInt
-sigSYS = CONST_SIGSYS :: CInt
-sigTRAP = CONST_SIGTRAP :: CInt
-sigURG = CONST_SIGURG :: CInt
-sigVTALRM = CONST_SIGVTALRM :: CInt
-sigXCPU = CONST_SIGXCPU :: CInt
-sigXFSZ = CONST_SIGXFSZ :: CInt
+sigABRT :: CInt
+sigABRT = CONST_SIGABRT
+sigALRM :: CInt
+sigALRM = CONST_SIGALRM
+sigBUS :: CInt
+sigBUS = CONST_SIGBUS
+sigCHLD :: CInt
+sigCHLD = CONST_SIGCHLD
+sigCONT :: CInt
+sigCONT = CONST_SIGCONT
+sigFPE :: CInt
+sigFPE = CONST_SIGFPE
+sigHUP :: CInt
+sigHUP = CONST_SIGHUP
+sigILL :: CInt
+sigILL = CONST_SIGILL
+sigINT :: CInt
+sigINT = CONST_SIGINT
+sigKILL :: CInt
+sigKILL = CONST_SIGKILL
+sigPIPE :: CInt
+sigPIPE = CONST_SIGPIPE
+sigQUIT :: CInt
+sigQUIT = CONST_SIGQUIT
+sigSEGV :: CInt
+sigSEGV = CONST_SIGSEGV
+sigSTOP :: CInt
+sigSTOP = CONST_SIGSTOP
+sigTERM :: CInt
+sigTERM = CONST_SIGTERM
+sigTSTP :: CInt
+sigTSTP = CONST_SIGTSTP
+sigTTIN :: CInt
+sigTTIN = CONST_SIGTTIN
+sigTTOU :: CInt
+sigTTOU = CONST_SIGTTOU
+sigUSR1 :: CInt
+sigUSR1 = CONST_SIGUSR1
+sigUSR2 :: CInt
+sigUSR2 = CONST_SIGUSR2
+sigPOLL :: CInt
+sigPOLL = CONST_SIGPOLL
+sigPROF :: CInt
+sigPROF = CONST_SIGPROF
+sigSYS :: CInt
+sigSYS = CONST_SIGSYS
+sigTRAP :: CInt
+sigTRAP = CONST_SIGTRAP
+sigURG :: CInt
+sigURG = CONST_SIGURG
+sigVTALRM :: CInt
+sigVTALRM = CONST_SIGVTALRM
+sigXCPU :: CInt
+sigXCPU = CONST_SIGXCPU
+sigXFSZ :: CInt
+sigXFSZ = CONST_SIGXFSZ
internalAbort ::Signal
internalAbort = sigABRT
-- -----------------------------------------------------------------------------
-- Signal-related functions
+-- | @signalProcess int pid@ calls @kill@ to signal process @pid@
+-- with interrupt signal @int@.
signalProcess :: Signal -> ProcessID -> IO ()
signalProcess sig pid
= throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
foreign import ccall unsafe "kill"
c_kill :: CPid -> CInt -> IO CInt
+
+-- | @signalProcessGroup int pgid@ calls @kill@ to signal
+-- all processes in group @pgid@ with interrupt signal @int@.
signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
signalProcessGroup sig pgid
= throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
foreign import ccall unsafe "killpg"
c_killpg :: CPid -> CInt -> IO CInt
+-- | @raiseSignal int@ calls @kill@ to signal the current process
+-- with interrupt signal @int@.
raiseSignal :: Signal -> IO ()
raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
| Catch (IO ())
| CatchOnce (IO ())
+-- | @installHandler int handler iset@ calls @sigaction@ to install an
+-- interrupt handler for signal @int@. If @handler@ is @Default@,
+-- @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is
+-- installed; if @handler@ is @Catch action@, a handler is installed
+-- which will invoke @action@ in a new thread when (or shortly after) the
+-- signal is received.
+-- If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure
+-- is set to @s@; otherwise it is cleared. The previously installed
+-- signal handler for @int@ is returned
installHandler :: Signal
-> Handler
- -> Maybe SignalSet -- other signals to block
- -> IO Handler -- old handler
+ -> Maybe SignalSet -- ^ other signals to block
+ -> IO Handler -- ^ old handler
#ifdef __PARALLEL_HASKELL__
installHandler =
#else
installHandler int handler maybe_mask = do
+ ensureIOManagerIsRunning -- for the threaded RTS
case maybe_mask of
Nothing -> install' nullPtr
Just (SignalSet x) -> withForeignPtr x $ install'
-- -----------------------------------------------------------------------------
-- Alarms
+-- | @scheduleAlarm i@ calls @alarm@ to schedule a real time
+-- alarm at least @i@ seconds in the future.
scheduleAlarm :: Int -> IO Int
scheduleAlarm secs = do
r <- c_alarm (fromIntegral secs)
r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
return (r /= 0)
+-- | @getSignalMask@ calls @sigprocmask@ to determine the
+-- set of interrupts which are currently being blocked.
getSignalMask :: IO SignalSet
getSignalMask = do
fp <- mallocForeignPtrBytes sizeof_sigset_t
sigProcMask fn how (SignalSet set) =
withForeignPtr set $ \p_set ->
throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
-
+
+-- | @setSignalMask mask@ calls @sigprocmask@ with
+-- @SIG_SETMASK@ to block all interrupts in @mask@.
setSignalMask :: SignalSet -> IO ()
setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
+-- | @blockSignals mask@ calls @sigprocmask@ with
+-- @SIG_BLOCK@ to add all interrupts in @mask@ to the
+-- set of blocked interrupts.
blockSignals :: SignalSet -> IO ()
blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
+-- | @unblockSignals mask@ calls @sigprocmask@ with
+-- @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the
+-- set of blocked interrupts.
unblockSignals :: SignalSet -> IO ()
unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
+-- | @getPendingSignals@ calls @sigpending@ to obtain
+-- the set of interrupts which have been received but are currently blocked.
getPendingSignals :: IO SignalSet
getPendingSignals = do
fp <- mallocForeignPtrBytes sizeof_sigset_t
return (SignalSet fp)
#ifndef cygwin32_HOST_OS
+
+-- | @awaitSignal iset@ suspends execution until an interrupt is received.
+-- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing
+-- @s@ as the new signal mask before suspending execution; otherwise, it
+-- calls @pause@. @awaitSignal@ returns on receipt of a signal. If you
+-- have installed any signal handlers with @installHandler@, it may be
+-- wise to call @yield@ directly after @awaitSignal@ to ensure that the
+-- signal handler runs as promptly as possible.
awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal maybe_sigset = do
fp <- case maybe_sigset of
projects / haskell-directory.git / blobdiff