{-# LINE 1 "System/Posix/Signals.hsc" #-}{-# LANGUAGE CApiFFI, CPP, DeriveDataTypeable, NondecreasingIndentation #-}{-# OPTIONS_GHC -fno-cse #-}-- global variables{-# LANGUAGE Trustworthy #-}------------------------------------------------------------------------------- |-- Module : System.Posix.Signals-- Copyright : (c) The University of Glasgow 2002-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : non-portable (requires POSIX)---- POSIX signal support-------------------------------------------------------------------------------
#include "HsUnixConfig.h"
{-# LINE 22 "System/Posix/Signals.hsc" #-}{-# LINE 24 "System/Posix/Signals.hsc" #-}moduleSystem.Posix.Signals(-- * The Signal typeSignal ,-- * Specific signalsnullSignal ,internalAbort ,sigABRT ,realTimeAlarm ,sigALRM ,busError ,sigBUS ,processStatusChanged ,sigCHLD ,continueProcess ,sigCONT ,floatingPointException ,sigFPE ,lostConnection ,sigHUP ,illegalInstruction ,sigILL ,keyboardSignal ,sigINT ,killProcess ,sigKILL ,openEndedPipe ,sigPIPE ,keyboardTermination ,sigQUIT ,segmentationViolation ,sigSEGV ,softwareStop ,sigSTOP ,softwareTermination ,sigTERM ,keyboardStop ,sigTSTP ,backgroundRead ,sigTTIN ,backgroundWrite ,sigTTOU ,userDefinedSignal1 ,sigUSR1 ,userDefinedSignal2 ,sigUSR2 ,{-# LINE 52 "System/Posix/Signals.hsc" #-}pollableEvent,sigPOLL ,{-# LINE 54 "System/Posix/Signals.hsc" #-}profilingTimerExpired,sigPROF ,badSystemCall ,sigSYS ,breakpointTrap ,sigTRAP ,urgentDataAvailable ,sigURG ,virtualTimerExpired ,sigVTALRM ,cpuTimeLimitExceeded ,sigXCPU ,fileSizeLimitExceeded ,sigXFSZ ,-- * Sending signalsraiseSignal ,signalProcess ,signalProcessGroup ,-- * Handling signalsHandler (Default ,Ignore ,Catch ,CatchOnce ,CatchInfo ,CatchInfoOnce ),SignalInfo (..),SignalSpecificInfo (..),installHandler ,-- * Signal setsSignalSet ,emptySignalSet ,fullSignalSet ,reservedSignals ,addSignal ,deleteSignal ,inSignalSet ,-- * The process signal maskgetSignalMask ,setSignalMask ,blockSignals ,unblockSignals ,-- * The alarm timerscheduleAlarm ,-- * Waiting for signalsgetPendingSignals ,awaitSignal ,-- * The @NOCLDSTOP@ flagsetStoppedChildFlag ,queryStoppedChildFlag ,-- MISSING FUNCTIONALITY:-- sigaction(), (inc. the sigaction structure + flags etc.)-- the siginfo structure-- sigaltstack()-- sighold, sigignore, sigpause, sigrelse, sigset-- siginterrupt)whereimportData.WordimportForeign.CimportForeign.ForeignPtrimportForeign.MarshalimportForeign.PtrimportForeign.Storable{-# LINE 108 "System/Posix/Signals.hsc" #-}importSystem.IO.Unsafe(unsafePerformIO)importSystem.Posix.TypesimportSystem.Posix.InternalsimportSystem.Posix.Process importSystem.Posix.Process.Internals importData.Dynamic{-# LINE 124 "System/Posix/Signals.hsc" #-}
#include "rts/Signals.h"
{-# LINE 126 "System/Posix/Signals.hsc" #-}importGHC.Conchiding(Signal){-# LINE 132 "System/Posix/Signals.hsc" #-}-- ------------------------------------------------------------------------------- Specific signalsnullSignal ::Signal nullSignal :: CInt
nullSignal =CInt
0-- | Process abort signal.sigABRT ::CIntsigABRT :: CInt
sigABRT =CONST_SIGABRT-- | Alarm clock.sigALRM ::CIntsigALRM :: CInt
sigALRM =CONST_SIGALRM-- | Access to an undefined portion of a memory object.sigBUS ::CIntsigBUS :: CInt
sigBUS =CONST_SIGBUS-- | Child process terminated, stopped, or continued.sigCHLD ::CIntsigCHLD :: CInt
sigCHLD =CONST_SIGCHLD-- | Continue executing, if stopped.sigCONT ::CIntsigCONT :: CInt
sigCONT =CONST_SIGCONT-- | Erroneous arithmetic operation.sigFPE ::CIntsigFPE :: CInt
sigFPE =CONST_SIGFPE-- | Hangup.sigHUP ::CIntsigHUP :: CInt
sigHUP =CONST_SIGHUP-- | Illegal instruction.sigILL ::CIntsigILL :: CInt
sigILL =CONST_SIGILL-- | Terminal interrupt signal.sigINT ::CIntsigINT :: CInt
sigINT =CONST_SIGINT-- | Kill (cannot be caught or ignored).sigKILL ::CIntsigKILL :: CInt
sigKILL =CONST_SIGKILL-- | Write on a pipe with no one to read it.sigPIPE ::CIntsigPIPE :: CInt
sigPIPE =CONST_SIGPIPE-- | Terminal quit signal.sigQUIT ::CIntsigQUIT :: CInt
sigQUIT =CONST_SIGQUIT-- | Invalid memory reference.sigSEGV ::CIntsigSEGV :: CInt
sigSEGV =CONST_SIGSEGV-- | Stop executing (cannot be caught or ignored).sigSTOP ::CIntsigSTOP :: CInt
sigSTOP =CONST_SIGSTOP-- | Termination signal.sigTERM ::CIntsigTERM :: CInt
sigTERM =CONST_SIGTERM-- | Terminal stop signal.sigTSTP ::CIntsigTSTP :: CInt
sigTSTP =CONST_SIGTSTP-- | Background process attempting read.sigTTIN ::CIntsigTTIN :: CInt
sigTTIN =CONST_SIGTTIN-- | Background process attempting write.sigTTOU ::CIntsigTTOU :: CInt
sigTTOU =CONST_SIGTTOU-- | User-defined signal 1.sigUSR1 ::CIntsigUSR1 :: CInt
sigUSR1 =CONST_SIGUSR1-- | User-defined signal 2.sigUSR2 ::CIntsigUSR2 :: CInt
sigUSR2 =CONST_SIGUSR2{-# LINE 220 "System/Posix/Signals.hsc" #-}-- | Pollable event.sigPOLL ::CIntsigPOLL :: CInt
sigPOLL =CONST_SIGPOLL{-# LINE 224 "System/Posix/Signals.hsc" #-}-- | Profiling timer expired.sigPROF ::CIntsigPROF :: CInt
sigPROF =CONST_SIGPROF-- | Bad system call.sigSYS ::CIntsigSYS :: CInt
sigSYS =CONST_SIGSYS-- | Trace/breakpoint trap.sigTRAP ::CIntsigTRAP :: CInt
sigTRAP =CONST_SIGTRAP-- | High bandwidth data is available at a socket.sigURG ::CIntsigURG :: CInt
sigURG =CONST_SIGURG-- | Virtual timer expired.sigVTALRM ::CIntsigVTALRM :: CInt
sigVTALRM =CONST_SIGVTALRM-- | CPU time limit exceeded.sigXCPU ::CIntsigXCPU :: CInt
sigXCPU =CONST_SIGXCPU-- | File size limit exceeded.sigXFSZ ::CIntsigXFSZ :: CInt
sigXFSZ =CONST_SIGXFSZ-- | Alias for 'sigABRT'.internalAbort ::Signal internalAbort :: CInt
internalAbort =CInt
sigABRT -- | Alias for 'sigALRM'.realTimeAlarm ::Signal realTimeAlarm :: CInt
realTimeAlarm =CInt
sigALRM -- | Alias for 'sigBUS'.busError ::Signal busError :: CInt
busError =CInt
sigBUS -- | Alias for 'sigCHLD'.processStatusChanged ::Signal processStatusChanged :: CInt
processStatusChanged =CInt
sigCHLD -- | Alias for 'sigCONT'.continueProcess ::Signal continueProcess :: CInt
continueProcess =CInt
sigCONT -- | Alias for 'sigFPE'.floatingPointException ::Signal floatingPointException :: CInt
floatingPointException =CInt
sigFPE -- | Alias for 'sigHUP'.lostConnection ::Signal lostConnection :: CInt
lostConnection =CInt
sigHUP -- | Alias for 'sigILL'.illegalInstruction ::Signal illegalInstruction :: CInt
illegalInstruction =CInt
sigILL -- | Alias for 'sigINT'.keyboardSignal ::Signal keyboardSignal :: CInt
keyboardSignal =CInt
sigINT -- | Alias for 'sigKILL'.killProcess ::Signal killProcess :: CInt
killProcess =CInt
sigKILL -- | Alias for 'sigPIPE'.openEndedPipe ::Signal openEndedPipe :: CInt
openEndedPipe =CInt
sigPIPE -- | Alias for 'sigQUIT'.keyboardTermination ::Signal keyboardTermination :: CInt
keyboardTermination =CInt
sigQUIT -- | Alias for 'sigSEGV'.segmentationViolation ::Signal segmentationViolation :: CInt
segmentationViolation =CInt
sigSEGV -- | Alias for 'sigSTOP'.softwareStop ::Signal softwareStop :: CInt
softwareStop =CInt
sigSTOP -- | Alias for 'sigTERM'.softwareTermination ::Signal softwareTermination :: CInt
softwareTermination =CInt
sigTERM -- | Alias for 'sigTSTP'.keyboardStop ::Signal keyboardStop :: CInt
keyboardStop =CInt
sigTSTP -- | Alias for 'sigTTIN'.backgroundRead ::Signal backgroundRead :: CInt
backgroundRead =CInt
sigTTIN -- | Alias for 'sigTTOU'.backgroundWrite ::Signal backgroundWrite :: CInt
backgroundWrite =CInt
sigTTOU -- | Alias for 'sigUSR1'.userDefinedSignal1 ::Signal userDefinedSignal1 :: CInt
userDefinedSignal1 =CInt
sigUSR1 -- | Alias for 'sigUSR2'.userDefinedSignal2 ::Signal userDefinedSignal2 :: CInt
userDefinedSignal2 =CInt
sigUSR2 {-# LINE 334 "System/Posix/Signals.hsc" #-}-- | Alias for 'sigPOLL'.pollableEvent ::Signal pollableEvent :: CInt
pollableEvent =CInt
sigPOLL {-# LINE 338 "System/Posix/Signals.hsc" #-}-- | Alias for 'sigPROF'.profilingTimerExpired ::Signal profilingTimerExpired :: CInt
profilingTimerExpired =CInt
sigPROF -- | Alias for 'sigSYS'.badSystemCall ::Signal badSystemCall :: CInt
badSystemCall =CInt
sigSYS -- | Alias for 'sigTRAP'.breakpointTrap ::Signal breakpointTrap :: CInt
breakpointTrap =CInt
sigTRAP -- | Alias for 'sigURG'.urgentDataAvailable ::Signal urgentDataAvailable :: CInt
urgentDataAvailable =CInt
sigURG -- | Alias for 'sigVTALRM'.virtualTimerExpired ::Signal virtualTimerExpired :: CInt
virtualTimerExpired =CInt
sigVTALRM -- | Alias for 'sigXCPU'.cpuTimeLimitExceeded ::Signal cpuTimeLimitExceeded :: CInt
cpuTimeLimitExceeded =CInt
sigXCPU -- | Alias for 'sigXFSZ'.fileSizeLimitExceeded ::Signal fileSizeLimitExceeded :: CInt
fileSizeLimitExceeded =CInt
sigXFSZ -- ------------------------------------------------------------------------------- Signal-related functions-- | @signalProcess int pid@ calls @kill@ to signal process @pid@-- with interrupt signal @int@.signalProcess ::Signal ->ProcessID->IO(){-# LINE 380 "System/Posix/Signals.hsc" #-}signalProcess :: CInt -> ProcessID -> IO ()
signalProcess CInt
sig ProcessID
pid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"signalProcess"(ProcessID -> CInt -> IO CInt
c_kill ProcessID
pid CInt
sig )foreignimportccallunsafe"kill"c_kill ::CPid->CInt->IOCInt{-# LINE 388 "System/Posix/Signals.hsc" #-}-- | @signalProcessGroup int pgid@ calls @kill@ to signal-- all processes in group @pgid@ with interrupt signal @int@.signalProcessGroup ::Signal ->ProcessGroupID->IO(){-# LINE 400 "System/Posix/Signals.hsc" #-}signalProcessGroup :: CInt -> ProcessID -> IO ()
signalProcessGroup CInt
sig ProcessID
pgid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"signalProcessGroup"(ProcessID -> CInt -> IO CInt
c_killpg ProcessID
pgid CInt
sig )foreignimportccallunsafe"killpg"c_killpg ::CPid->CInt->IOCInt{-# LINE 408 "System/Posix/Signals.hsc" #-}-- | @raiseSignal int@ calls @kill@ to signal the current process-- with interrupt signal @int@.raiseSignal ::Signal ->IO(){-# LINE 419 "System/Posix/Signals.hsc" #-}raiseSignal :: CInt -> IO ()
raiseSignal CInt
sig =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"raiseSignal"(CInt -> IO CInt
c_raise CInt
sig )-- See also note in GHC's rts/RtsUtils.c-- This is somewhat fragile because we need to keep the-- `#if`-conditional in sync with GHC's runtime.{-# LINE 429 "System/Posix/Signals.hsc" #-}foreignimportccallunsafe"raise"c_raise ::CInt->IOCInt{-# LINE 432 "System/Posix/Signals.hsc" #-}{-# LINE 434 "System/Posix/Signals.hsc" #-}typeSignal =CInt-- | The actions to perform when a signal is received.dataHandler =Default -- ^ Sets the disposition of the signal to @SIG_DFL@, which-- means we want the default action associated with the-- signal. For example, the default action for @SIGTERM@ (and-- various other signals) is to terminate the process.|Ignore -- ^ Set the disposition of the signal to @SIG_IGN@, which-- means we want to /ignore/ the signal. Ignored signals will-- not be delivered to the process, and if also /blocked/ will-- not be added to the pending set for later delivery (if/when-- unblocked). Some signals (e.g. @SIGSTOP@ and @SIGKILL@)-- cannot be caught or ignored.-- not yet: | Hold|Catch (IO())-- ^ signal handler is not reset|CatchOnce (IO())-- ^ signal handler is automatically reset (via @SA_RESETHAND@)|CatchInfo (SignalInfo ->IO())-- ^ @since 2.7.0.0|CatchInfoOnce (SignalInfo ->IO())-- ^ @since 2.7.0.0deriving(Typeable)-- | Information about a received signal (derived from @siginfo_t@).---- @since 2.7.0.0dataSignalInfo =SignalInfo {SignalInfo -> CInt
siginfoSignal ::Signal ,SignalInfo -> Errno
siginfoError ::Errno,SignalInfo -> SignalSpecificInfo
siginfoSpecific ::SignalSpecificInfo }-- | Information specific to a particular type of signal-- (derived from @siginfo_t@).---- @since 2.7.0.0dataSignalSpecificInfo =NoSignalSpecificInfo |SigChldInfo {SignalSpecificInfo -> ProcessID
siginfoPid ::ProcessID,SignalSpecificInfo -> UserID
siginfoUid ::UserID,SignalSpecificInfo -> ProcessStatus
siginfoStatus ::ProcessStatus }-- | @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 returnedinstallHandler ::Signal ->Handler ->MaybeSignalSet -- ^ other signals to block->IOHandler -- ^ old handler{-# LINE 506 "System/Posix/Signals.hsc" #-}installHandler :: CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sig Handler
handler Maybe SignalSet
_maybe_mask =doIO ()
ensureIOManagerIsRunning-- for the threaded RTS-- if we're setting the action to DFL or IGN, we should do that *first*-- if we're setting a handler,-- if the previous action was handle, then setHandler is ok-- if the previous action was IGN/DFL, then setHandler followed by sig_install(CInt
old_action ,Maybe (HandlerFun, Dynamic)
old_handler )<-caseHandler
handler ofHandler
Ignore ->doCInt
old_action <-CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig STG_SIG_IGNnullPtrMaybe (HandlerFun, Dynamic)
old_handler <-CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig Maybe (HandlerFun, Dynamic)
forall a. Maybe a
Nothing(CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CInt
old_action ,Maybe (HandlerFun, Dynamic)
old_handler )Handler
Default ->doCInt
old_action <-CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig STG_SIG_DFLnullPtrMaybe (HandlerFun, Dynamic)
old_handler <-CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig Maybe (HandlerFun, Dynamic)
forall a. Maybe a
Nothing(CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CInt
old_action ,Maybe (HandlerFun, Dynamic)
old_handler )Handler
_some_kind_of_catch ->do-- I don't think it's possible to get CatchOnce right. If-- there's a signal in flight, then we might run the handler-- more than once.letdyn :: Dynamic
dyn =Handler -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynHandler
handler Maybe (HandlerFun, Dynamic)
old_handler <-caseHandler
handler ofCatch IO ()
action ->CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just(IO () -> HandlerFun
forall a b. a -> b -> a
constIO ()
action ,Dynamic
dyn ))CatchOnce IO ()
action ->CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just(IO () -> HandlerFun
forall a b. a -> b -> a
constIO ()
action ,Dynamic
dyn ))CatchInfo SignalInfo -> IO ()
action ->CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just((SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
action ,Dynamic
dyn ))CatchInfoOnce SignalInfo -> IO ()
action ->CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandlerCInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just((SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
action ,Dynamic
dyn )){-# LINE 539 "System/Posix/Signals.hsc" #-}letaction :: CInt
action =caseHandler
handler ofCatch IO ()
_->STG_SIG_HANCatchOnce IO ()
_->STG_SIG_RSTCatchInfo SignalInfo -> IO ()
_->STG_SIG_HANCatchInfoOnce SignalInfo -> IO ()
_->STG_SIG_RST{-# LINE 548 "System/Posix/Signals.hsc" #-}CInt
old_action <-CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig CInt
action Ptr CSigset
forall a. Ptr a
nullPtr-- mask is pointless, so leave it NULL(CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CInt
old_action ,Maybe (HandlerFun, Dynamic)
old_handler )case(Maybe (HandlerFun, Dynamic)
old_handler ,CInt
old_action )of(Maybe (HandlerFun, Dynamic)
_,STG_SIG_DFL)->return$Default(Maybe (HandlerFun, Dynamic)
_,STG_SIG_IGN)->return$Ignore(Maybe (HandlerFun, Dynamic)
Nothing,CInt
_)->Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Handler -> IO Handler) -> Handler -> IO Handler
forall a b. (a -> b) -> a -> b
$Handler
Ignore (Just(HandlerFun
_,Dynamic
dyn ),CInt
_)|JustHandler
h <-Dynamic -> Maybe Handler
forall a. Typeable a => Dynamic -> Maybe a
fromDynamicDynamic
dyn ->Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnHandler
h |JustIO ()
io <-Dynamic -> Maybe (IO ())
forall a. Typeable a => Dynamic -> Maybe a
fromDynamicDynamic
dyn ->Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(IO () -> Handler
Catch IO ()
io )-- handlers put there by the base package have type IO ()|Bool
otherwise->Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnHandler
Default foreignimportccallunsafestg_sig_install ::CInt-- sig no.->CInt-- action code (STG_SIG_HAN etc.)->PtrCSigset-- (in, out) blocked->IOCInt-- (ret) old action codegetinfo ::(SignalInfo ->IO())->ForeignPtrWord8->IO()getinfo :: (SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
handler ForeignPtr Word8
fp_info =doSignalInfo
si <-ForeignPtr Word8 -> IO SignalInfo
unmarshalSigInfo ForeignPtr Word8
fp_info SignalInfo -> IO ()
handler SignalInfo
si unmarshalSigInfo ::ForeignPtrWord8->IOSignalInfo unmarshalSigInfo :: ForeignPtr Word8 -> IO SignalInfo
unmarshalSigInfo ForeignPtr Word8
fp =doForeignPtr Word8 -> (Ptr Word8 -> IO SignalInfo) -> IO SignalInfo
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr Word8
fp ((Ptr Word8 -> IO SignalInfo) -> IO SignalInfo)
-> (Ptr Word8 -> IO SignalInfo) -> IO SignalInfo
forall a b. (a -> b) -> a -> b
$\Ptr Word8
p ->doCInt
sig <-((\Ptr Word8
hsc_ptr ->Ptr Word8 -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOffPtr Word8
hsc_ptr Int
0))Ptr Word8
p {-# LINE 580 "System/Posix/Signals.hsc" #-}errno<-((\hsc_ptr->peekByteOffhsc_ptr4))p{-# LINE 581 "System/Posix/Signals.hsc" #-}extra<-casesigof_|sig==sigCHLD->dopid<-((\hsc_ptr->peekByteOffhsc_ptr16))p{-# LINE 584 "System/Posix/Signals.hsc" #-}uid<-((\hsc_ptr->peekByteOffhsc_ptr20))p{-# LINE 585 "System/Posix/Signals.hsc" #-}wstat<-((\hsc_ptr->peekByteOffhsc_ptr24))p{-# LINE 586 "System/Posix/Signals.hsc" #-}pstat<-decipherWaitStatuswstatreturnSigChldInfo{siginfoPid=pid,siginfoUid=uid,siginfoStatus=pstat}_|otherwise->returnNoSignalSpecificInfoSignalInfo -> IO SignalInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnSignalInfo {siginfoSignal :: CInt
siginfoSignal =CInt
sig ,siginfoError :: Errno
siginfoError =CInt -> Errno
ErrnoCInt
errno ,siginfoSpecific :: SignalSpecificInfo
siginfoSpecific =SignalSpecificInfo
extra }{-# LINE 599 "System/Posix/Signals.hsc" #-}{-# LINE 608 "System/Posix/Signals.hsc" #-}-- ------------------------------------------------------------------------------- Alarms-- | @scheduleAlarm i@ calls @alarm@ to schedule a real time-- alarm at least @i@ seconds in the future.scheduleAlarm ::Int->IOIntscheduleAlarm :: Int -> IO Int
scheduleAlarm Int
secs =doCUInt
r <-CUInt -> IO CUInt
c_alarm (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
secs )Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralCUInt
r )foreignimportccallunsafe"alarm"c_alarm ::CUInt->IOCUInt{-# LINE 623 "System/Posix/Signals.hsc" #-}-- ------------------------------------------------------------------------------- The NOCLDSTOP flag{-# LINE 638 "System/Posix/Signals.hsc" #-}foreignimportccall"&nocldstop"nocldstop ::PtrInt-- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when-- installing new signal handlers.setStoppedChildFlag ::Bool->IOBoolsetStoppedChildFlag :: Bool -> IO Bool
setStoppedChildFlag Bool
b =doInt
rc <-Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peekPtr Int
nocldstop Ptr Int -> Int -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
pokePtr Int
nocldstop (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$Bool -> Int
forall a. Enum a => a -> Int
fromEnum(Bool -> Bool
notBool
b )Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(Int
0::Int))-- | Queries the current state of the stopped child flag.queryStoppedChildFlag ::IOBoolqueryStoppedChildFlag :: IO Bool
queryStoppedChildFlag =doInt
rc <-Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peekPtr Int
nocldstop Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(Int
0::Int)){-# LINE 656 "System/Posix/Signals.hsc" #-}-- ------------------------------------------------------------------------------- Manipulating signal sets{-# LINE 661 "System/Posix/Signals.hsc" #-}newtypeSignalSet =SignalSet (ForeignPtrCSigset){-# LINE 669 "System/Posix/Signals.hsc" #-}{-# LINE 704 "System/Posix/Signals.hsc" #-}emptySignalSet ::SignalSet emptySignalSet :: SignalSet
emptySignalSet =IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO(IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$doForeignPtr CSigset
fp <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tString -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"emptySignalSet"(ForeignPtr CSigset -> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO CInt) -> IO CInt)
-> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$Ptr CSigset -> IO CInt
c_sigemptyset)SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp )fullSignalSet ::SignalSet fullSignalSet :: SignalSet
fullSignalSet =IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO(IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$doForeignPtr CSigset
fp <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tString -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"fullSignalSet"(ForeignPtr CSigset -> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO CInt) -> IO CInt)
-> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$Ptr CSigset -> IO CInt
c_sigfillset )SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp )-- | A set of signals reserved for use by the implementation. In GHC, this will normally-- include either `sigVTALRM` or `sigALRM`.reservedSignals ::SignalSet reservedSignals :: SignalSet
reservedSignals =CInt -> SignalSet -> SignalSet
addSignal CInt
rtsTimerSignal SignalSet
emptySignalSet foreignimportccallrtsTimerSignal ::CIntinfixr`addSignal` ,`deleteSignal` addSignal ::Signal ->SignalSet ->SignalSet addSignal :: CInt -> SignalSet -> SignalSet
addSignal CInt
sig (SignalSet ForeignPtr CSigset
fp1 )=IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO(IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$doForeignPtr CSigset
fp2 <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp1 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p1 ->ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp2 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p2 ->doPtr CSigset -> Ptr CSigset -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytesPtr CSigset
p2 Ptr CSigset
p1 Int
sizeof_sigset_tString -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"addSignal"(Ptr CSigset -> CInt -> IO CInt
c_sigaddsetPtr CSigset
p2 CInt
sig )SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp2 )deleteSignal ::Signal ->SignalSet ->SignalSet deleteSignal :: CInt -> SignalSet -> SignalSet
deleteSignal CInt
sig (SignalSet ForeignPtr CSigset
fp1 )=IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO(IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$doForeignPtr CSigset
fp2 <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp1 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p1 ->ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp2 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p2 ->doPtr CSigset -> Ptr CSigset -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytesPtr CSigset
p2 Ptr CSigset
p1 Int
sizeof_sigset_tString -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"deleteSignal"(Ptr CSigset -> CInt -> IO CInt
c_sigdelset Ptr CSigset
p2 CInt
sig )SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp2 )inSignalSet ::Signal ->SignalSet ->BoolinSignalSet :: CInt -> SignalSet -> Bool
inSignalSet CInt
sig (SignalSet ForeignPtr CSigset
fp )=IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO(IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ForeignPtr CSigset -> (Ptr CSigset -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO Bool) -> IO Bool)
-> (Ptr CSigset -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p ->doCInt
r <-String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1String
"inSignalSet"(Ptr CSigset -> CInt -> IO CInt
c_sigismember Ptr CSigset
p CInt
sig )Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=CInt
0){-# LINE 750 "System/Posix/Signals.hsc" #-}{-# LINE 774 "System/Posix/Signals.hsc" #-}-- | @getSignalMask@ calls @sigprocmask@ to determine the-- set of interrupts which are currently being blocked.getSignalMask ::IOSignalSet getSignalMask :: IO SignalSet
getSignalMask =doForeignPtr CSigset
fp <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p ->String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"getSignalMask"(CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmaskCInt
0Ptr CSigset
forall a. Ptr a
nullPtrPtr CSigset
p )SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp )sigProcMask ::String->CInt->SignalSet ->IO()sigProcMask :: String -> CInt -> SignalSet -> IO ()
sigProcMask String
fn CInt
how (SignalSet ForeignPtr CSigset
set )=ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
set ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p_set ->String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
fn (CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmaskCInt
how Ptr CSigset
p_set Ptr CSigset
forall a. Ptr a
nullPtr)-- | @setSignalMask mask@ calls @sigprocmask@ with-- @SIG_SETMASK@ to block all interrupts in @mask@.setSignalMask ::SignalSet ->IO()setSignalMask :: SignalSet -> IO ()
setSignalMask SignalSet
set =String -> CInt -> SignalSet -> IO ()
sigProcMask String
"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 :: SignalSet -> IO ()
blockSignals SignalSet
set =String -> CInt -> SignalSet -> IO ()
sigProcMask String
"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 :: SignalSet -> IO ()
unblockSignals SignalSet
set =String -> CInt -> SignalSet -> IO ()
sigProcMask String
"unblockSignals"(CONST_SIG_UNBLOCK::CInt)set{-# LINE 807 "System/Posix/Signals.hsc" #-}{-# LINE 821 "System/Posix/Signals.hsc" #-}-- | @getPendingSignals@ calls @sigpending@ to obtain-- the set of interrupts which have been received but are currently blocked.getPendingSignals ::IOSignalSet getPendingSignals :: IO SignalSet
getPendingSignals =doForeignPtr CSigset
fp <-Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytesInt
sizeof_sigset_tForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p ->String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"getPendingSignals"(Ptr CSigset -> IO CInt
c_sigpending Ptr CSigset
p )SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp )-- | @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 @sigsuspend@ with current signal mask. Note that RTS-- scheduler signal (either 'virtualTimerExpired' or 'realTimeAlarm')-- could cause premature termination of this call. It might be necessary to block that-- signal before invocation of @awaitSignal@ with 'blockSignals' 'reservedSignals'.---- @awaitSignal@ returns when signal was received and processed by a-- signal handler, or if the signal could not be caught. 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 ::MaybeSignalSet ->IO()awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal Maybe SignalSet
maybe_sigset =doForeignPtr CSigset
fp <-caseMaybe SignalSet
maybe_sigset ofMaybe SignalSet
Nothing->doSignalSet ForeignPtr CSigset
fp <-IO SignalSet
getSignalMask ;ForeignPtr CSigset -> IO (ForeignPtr CSigset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnForeignPtr CSigset
fp Just(SignalSet ForeignPtr CSigset
fp )->ForeignPtr CSigset -> IO (ForeignPtr CSigset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnForeignPtr CSigset
fp ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtrForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Ptr CSigset
p ->doCInt
_<-Ptr CSigset -> IO CInt
c_sigsuspend Ptr CSigset
p () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return()-- ignore the return value; according to the docs it can only ever be-- (-1) with errno set to EINTR.-- XXX My manpage says it can also return EFAULT. And why is ignoring-- EINTR the right thing to do?{-# LINE 858 "System/Posix/Signals.hsc" #-}{-# LINE 860 "System/Posix/Signals.hsc" #-}foreignimportccallunsafe"sigsuspend"c_sigsuspend ::PtrCSigset->IOCIntforeignimportcapiunsafe"signal.h sigdelset"c_sigdelset ::PtrCSigset->CInt->IOCIntforeignimportcapiunsafe"signal.h sigfillset"c_sigfillset ::PtrCSigset->IOCIntforeignimportcapiunsafe"signal.h sigismember"c_sigismember ::PtrCSigset->CInt->IOCIntforeignimportccallunsafe"sigpending"c_sigpending ::PtrCSigset->IOCInt{-# LINE 877 "System/Posix/Signals.hsc" #-}