--
-----------------------------------------------------------------------------
+#include "ghcconfig.h"
+
module System.Posix.Signals (
+#ifndef mingw32_TARGET_OS
-- * The Signal type
Signal,
backgroundWrite, sigTTOU,
userDefinedSignal1, sigUSR1,
userDefinedSignal2, sigUSR2,
+#ifdef SIGPOLL
pollableEvent, sigPOLL,
+#endif
profilingTimerExpired, sigPROF,
badSystemCall, sigSYS,
breakpointTrap, sigTRAP,
signalProcess,
signalProcessGroup,
+#ifdef __GLASGOW_HASKELL__
-- * Handling signals
Handler(..),
installHandler,
+#endif
-- * Signal sets
SignalSet,
scheduleAlarm,
-- * Waiting for signals
- getPendingSignals, awaitSignal,
+ getPendingSignals,
+#ifndef cygwin32_TARGET_OS
+ awaitSignal,
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+ -- * The @NOCLDSTOP@ flag
+ setStoppedChildFlag, queryStoppedChildFlag,
+#endif
-- MISSING FUNCTIONALITY:
-- sigaction(), (inc. the sigaction structure + flags etc.)
-- sigaltstack()
-- sighold, sigignore, sigpause, sigrelse, sigset
-- siginterrupt
-
+#endif
) where
+#ifdef __GLASGOW_HASKELL__
#include "Signals.h"
+#else
+#include "HsBase.h"
+#endif
import Foreign
import Foreign.C
import System.IO.Unsafe
import System.Posix.Types
-import GHC.Posix
+import System.Posix.Internals
+
+#ifndef mingw32_TARGET_OS
+-- WHOLE FILE...
-- -----------------------------------------------------------------------------
-- Specific signals
nullSignal :: Signal
nullSignal = 0
-foreign import ccall "__hsposix_SIGABRT" sigABRT :: CInt
-foreign import ccall "__hsposix_SIGALRM" sigALRM :: CInt
-foreign import ccall "__hsposix_SIGBUS" sigBUS :: CInt
-foreign import ccall "__hsposix_SIGCHLD" sigCHLD :: CInt
-foreign import ccall "__hsposix_SIGCONT" sigCONT :: CInt
-foreign import ccall "__hsposix_SIGFPE" sigFPE :: CInt
-foreign import ccall "__hsposix_SIGHUP" sigHUP :: CInt
-foreign import ccall "__hsposix_SIGILL" sigILL :: CInt
-foreign import ccall "__hsposix_SIGINT" sigINT :: CInt
-foreign import ccall "__hsposix_SIGKILL" sigKILL :: CInt
-foreign import ccall "__hsposix_SIGPIPE" sigPIPE :: CInt
-foreign import ccall "__hsposix_SIGQUIT" sigQUIT :: CInt
-foreign import ccall "__hsposix_SIGSEGV" sigSEGV :: CInt
-foreign import ccall "__hsposix_SIGSTOP" sigSTOP :: CInt
-foreign import ccall "__hsposix_SIGTERM" sigTERM :: CInt
-foreign import ccall "__hsposix_SIGTSTP" sigTSTP :: CInt
-foreign import ccall "__hsposix_SIGTTIN" sigTTIN :: CInt
-foreign import ccall "__hsposix_SIGTTOU" sigTTOU :: CInt
-foreign import ccall "__hsposix_SIGUSR1" sigUSR1 :: CInt
-foreign import ccall "__hsposix_SIGUSR2" sigUSR2 :: CInt
-foreign import ccall "__hsposix_SIGPOLL" sigPOLL :: CInt
-foreign import ccall "__hsposix_SIGPROF" sigPROF :: CInt
-foreign import ccall "__hsposix_SIGSYS" sigSYS :: CInt
-foreign import ccall "__hsposix_SIGTRAP" sigTRAP :: CInt
-foreign import ccall "__hsposix_SIGURG" sigURG :: CInt
-foreign import ccall "__hsposix_SIGVTALRM" sigVTALRM :: CInt
-foreign import ccall "__hsposix_SIGXCPU" sigXCPU :: CInt
-foreign import ccall "__hsposix_SIGXFSZ" sigXFSZ :: CInt
+#ifdef __HUGS__
+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
+#ifdef SIGPOLL
+sigPOLL = (#const SIGPOLL) :: CInt
+#endif
+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
+#else
+foreign import ccall unsafe "__hsposix_SIGABRT" sigABRT :: CInt
+foreign import ccall unsafe "__hsposix_SIGALRM" sigALRM :: CInt
+foreign import ccall unsafe "__hsposix_SIGBUS" sigBUS :: CInt
+foreign import ccall unsafe "__hsposix_SIGCHLD" sigCHLD :: CInt
+foreign import ccall unsafe "__hsposix_SIGCONT" sigCONT :: CInt
+foreign import ccall unsafe "__hsposix_SIGFPE" sigFPE :: CInt
+foreign import ccall unsafe "__hsposix_SIGHUP" sigHUP :: CInt
+foreign import ccall unsafe "__hsposix_SIGILL" sigILL :: CInt
+foreign import ccall unsafe "__hsposix_SIGINT" sigINT :: CInt
+foreign import ccall unsafe "__hsposix_SIGKILL" sigKILL :: CInt
+foreign import ccall unsafe "__hsposix_SIGPIPE" sigPIPE :: CInt
+foreign import ccall unsafe "__hsposix_SIGQUIT" sigQUIT :: CInt
+foreign import ccall unsafe "__hsposix_SIGSEGV" sigSEGV :: CInt
+foreign import ccall unsafe "__hsposix_SIGSTOP" sigSTOP :: CInt
+foreign import ccall unsafe "__hsposix_SIGTERM" sigTERM :: CInt
+foreign import ccall unsafe "__hsposix_SIGTSTP" sigTSTP :: CInt
+foreign import ccall unsafe "__hsposix_SIGTTIN" sigTTIN :: CInt
+foreign import ccall unsafe "__hsposix_SIGTTOU" sigTTOU :: CInt
+foreign import ccall unsafe "__hsposix_SIGUSR1" sigUSR1 :: CInt
+foreign import ccall unsafe "__hsposix_SIGUSR2" sigUSR2 :: CInt
+#ifdef SIGPOLL
+foreign import ccall unsafe "__hsposix_SIGPOLL" sigPOLL :: CInt
+#endif
+foreign import ccall unsafe "__hsposix_SIGPROF" sigPROF :: CInt
+foreign import ccall unsafe "__hsposix_SIGSYS" sigSYS :: CInt
+foreign import ccall unsafe "__hsposix_SIGTRAP" sigTRAP :: CInt
+foreign import ccall unsafe "__hsposix_SIGURG" sigURG :: CInt
+foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
+foreign import ccall unsafe "__hsposix_SIGXCPU" sigXCPU :: CInt
+foreign import ccall unsafe "__hsposix_SIGXFSZ" sigXFSZ :: CInt
+#endif /* __HUGS__ */
internalAbort ::Signal
internalAbort = sigABRT
processStatusChanged :: Signal
processStatusChanged = sigCHLD
-#ifndef cygwin32_TARGET_OS
continueProcess :: Signal
continueProcess = sigCONT
-#endif
floatingPointException :: Signal
floatingPointException = sigFPE
userDefinedSignal2 :: Signal
userDefinedSignal2 = sigUSR2
+#ifdef SIGPOLL
pollableEvent :: Signal
pollableEvent = sigPOLL
+#endif
profilingTimerExpired :: Signal
profilingTimerExpired = sigPROF
raiseSignal :: Signal -> IO ()
raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
+#if defined(__GLASGOW_HASKELL__) && (defined(openbsd_TARGET_OS) || defined(freebsd_TARGET_OS))
+foreign import ccall unsafe "genericRaise"
+ c_raise :: CInt -> IO CInt
+#else
foreign import ccall unsafe "raise"
c_raise :: CInt -> IO CInt
+#endif
+#ifdef __GLASGOW_HASKELL__
data Handler = Default
| Ignore
-- not yet: | Hold
| Catch (IO ())
+ | CatchOnce (IO ())
installHandler :: Signal
-> Handler
rc <- case handler of
Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
- Catch m -> do sptr <- newStablePtr m
- poke p_sp sptr
- stg_sig_install int (#const STG_SIG_HAN) p_sp mask
+ Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
+ CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
case rc of
(#const STG_SIG_DFL) -> return Default
(#const STG_SIG_IGN) -> return Ignore
(#const STG_SIG_ERR) -> throwErrno "installHandler"
(#const STG_SIG_HAN) -> do
- osptr <- peek p_sp
- m <- deRefStablePtr osptr
+ m <- peekHandler p_sp
return (Catch m)
+ (#const STG_SIG_RST) -> do
+ m <- peekHandler p_sp
+ return (CatchOnce m)
+
+ install'' m p_sp mask int reset = do
+ sptr <- newStablePtr m
+ poke p_sp sptr
+ stg_sig_install int reset p_sp mask
+
+ peekHandler p_sp = do
+ osptr <- peek p_sp
+ deRefStablePtr osptr
foreign import ccall unsafe
stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
-> IO CInt
-#endif // !__PARALLEL_HASKELL__
+#endif /* !__PARALLEL_HASKELL__ */
+#endif /* __GLASGOW_HASKELL__ */
-- -----------------------------------------------------------------------------
-- Alarms
foreign import ccall unsafe "alarm"
c_alarm :: CUInt -> IO CUInt
+#ifdef __GLASGOW_HASKELL__
+-- -----------------------------------------------------------------------------
+-- The NOCLDSTOP flag
+
+foreign import ccall "&nocldstop" nocldstop :: Ptr Int
+
+-- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
+-- installing new signal handlers.
+setStoppedChildFlag :: Bool -> IO Bool
+setStoppedChildFlag b = do
+ rc <- peek nocldstop
+ poke nocldstop $ fromEnum (not b)
+ return (rc == (0::Int))
+
+-- | Queries the current state of the stopped child flag.
+queryStoppedChildFlag :: IO Bool
+queryStoppedChildFlag = do
+ rc <- peek nocldstop
+ return (rc == (0::Int))
+#endif /* __GLASGOW_HASKELL__ */
+
-- -----------------------------------------------------------------------------
-- Manipulating signal sets
getSignalMask = do
fp <- mallocForeignPtrBytes sizeof_sigset_t
withForeignPtr fp $ \p ->
- throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 p nullPtr)
+ throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
return (SignalSet fp)
sigProcMask :: String -> CInt -> SignalSet -> IO ()
c_sigsuspend :: Ptr CSigset -> IO CInt
#endif
+#ifdef __HUGS__
+foreign import ccall unsafe "sigdelset"
+ c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
+
+foreign import ccall unsafe "sigfillset"
+ c_sigfillset :: Ptr CSigset -> IO CInt
+
+foreign import ccall unsafe "sigismember"
+ c_sigismember :: Ptr CSigset -> CInt -> IO CInt
+#else
foreign import ccall unsafe "__hscore_sigdelset"
c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
foreign import ccall unsafe "__hscore_sigismember"
c_sigismember :: Ptr CSigset -> CInt -> IO CInt
+#endif /* __HUGS__ */
foreign import ccall unsafe "sigpending"
c_sigpending :: Ptr CSigset -> IO CInt
+#ifdef __HUGS__
+c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
+c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
+c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
+#else
foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
+#endif /* __HUGS__ */
+
+#endif /* mingw32_TARGET_OS */
+
projects / haskell-directory.git / blobdiff