Movatterモバイル変換

{-# LANGUAGE Unsafe #-}{-# LANGUAGE CPP           , NoImplicitPrelude           , ScopedTypeVariables           , BangPatterns  #-}moduleGHC.Event.Control(-- * Managing the IO managerSignal,ControlMessage(..),Control,newControl,closeControl-- ** Control message reception,readControlMessage-- *** File descriptors,controlReadFd,controlWriteFd,wakeupReadFd-- ** Control message sending,sendWakeup,sendDie-- * Utilities,setNonBlockingFD)where#include "EventConfig.h"importForeign.ForeignPtr(ForeignPtr)importGHC.BaseimportGHC.IORefimportGHC.Conc.Signal(Signal)importGHC.Real(fromIntegral)importGHC.Show(Show)importGHC.Word(Word8)importForeign.C.Error(throwErrnoIfMinus1_,throwErrno,getErrno)importForeign.C.Types(CInt(..),CSize(..))importForeign.ForeignPtr(mallocForeignPtrBytes,withForeignPtr)importForeign.Marshal(alloca,allocaBytes)importForeign.Marshal.Array(allocaArray)importForeign.Ptr(castPtr)importForeign.Storable(peek,peekElemOff,poke)importSystem.Posix.Internals(c_close,c_pipe,c_read,c_write,setCloseOnExec,setNonBlockingFD)importSystem.Posix.Types(Fd)#if defined(HAVE_EVENTFD)importForeign.C.Error(throwErrnoIfMinus1,eBADF)importForeign.C.Types(CULLong(..))#elseimportForeign.C.Error(eAGAIN,eWOULDBLOCK)#endifdataControlMessage=CMsgWakeup|CMsgDie|CMsgSignal{-# UNPACK#-}!(ForeignPtrWord8){-# UNPACK#-}!Signalderiving(Eq-- ^ @since 4.4.0.0,Show-- ^ @since 4.4.0.0)-- | The structure used to tell the IO manager thread what to do.dataControl=W{controlReadFd::{-# UNPACK#-}!Fd,controlWriteFd::{-# UNPACK#-}!Fd#if defined(HAVE_EVENTFD),controlEventFd::{-# UNPACK#-}!Fd#else,wakeupReadFd::{-# UNPACK#-}!Fd,wakeupWriteFd::{-# UNPACK#-}!Fd#endif    , didRegisterWakeupFd :: !Bool      -- | Have this Control's fds been cleaned up?    , controlIsDead  :: !(IORef Bool)    }#if defined(HAVE_EVENTFD)wakeupReadFd::Control->FdwakeupReadFd=controlEventFd{-# INLINEwakeupReadFd#-}#endif-- | Create the structure (usually a pipe) used for waking up the IO-- manager thread from another thread.newControl::Bool->IOControlnewControlshouldRegister=allocaArray2$\fds->doletcreatePipe=dothrowErrnoIfMinus1_"pipe"$c_pipefdsrd<-peekElemOfffds0wr<-peekElemOfffds1-- The write end must be non-blocking, since we may need to-- poke the event manager from a signal handler.setNonBlockingFDwrTruesetCloseOnExecrdsetCloseOnExecwrreturn(rd,wr)(ctrl_rd,ctrl_wr)<-createPipe#if defined(HAVE_EVENTFD)ev<-throwErrnoIfMinus1"eventfd"$c_eventfd00setNonBlockingFDevTruesetCloseOnExecevwhenshouldRegister$c_setIOManagerWakeupFdev#else(wake_rd,wake_wr)<-createPipewhenshouldRegister$c_setIOManagerWakeupFdwake_wr#endifisDead<-newIORefFalsereturnW{controlReadFd=fromIntegralctrl_rd,controlWriteFd=fromIntegralctrl_wr#if defined(HAVE_EVENTFD),controlEventFd=fromIntegralev#else,wakeupReadFd=fromIntegralwake_rd,wakeupWriteFd=fromIntegralwake_wr#endif           , didRegisterWakeupFd = shouldRegister           , controlIsDead  = isDead           }-- | Close the control structure used by the IO manager thread.-- N.B. If this Control is the Control whose wakeup file was registered with-- the RTS, then *BEFORE* the wakeup file is closed, we must call-- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup-- file after it has been closed.closeControl :: Control -> IO ()closeControl w = do  atomicModifyIORef (controlIsDead w) (\_ -> (True, ()))  _ <- c_close . fromIntegral . controlReadFd $ w  _ <- c_close . fromIntegral . controlWriteFd $ w  when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1)#if defined(HAVE_EVENTFD)_<-c_close.fromIntegral.controlEventFd$w#else_<-c_close.fromIntegral.wakeupReadFd$w_<-c_close.fromIntegral.wakeupWriteFd$w#endifreturn()io_MANAGER_WAKEUP,io_MANAGER_DIE::Word8io_MANAGER_WAKEUP=0xffio_MANAGER_DIE=0xfeforeignimportccall"__hscore_sizeof_siginfo_t"sizeof_siginfo_t::CSizereadControlMessage::Control->Fd->IOControlMessagereadControlMessagectrlfd|fd==wakeupReadFdctrl=allocaByteswakeupBufferSize$\p->dothrowErrnoIfMinus1_"readWakeupMessage"$c_read(fromIntegralfd)p(fromIntegralwakeupBufferSize)returnCMsgWakeup|otherwise=alloca$\p->dothrowErrnoIfMinus1_"readControlMessage"$c_read(fromIntegralfd)p1s<-peekpcasesof-- Wakeup messages shouldn't be sent on the control-- file descriptor but we handle them anyway._|s==io_MANAGER_WAKEUP->returnCMsgWakeup_|s==io_MANAGER_DIE->returnCMsgDie_->do-- Signalfp<-mallocForeignPtrBytes(fromIntegralsizeof_siginfo_t)withForeignPtrfp$\p_siginfo->dor<-c_read(fromIntegralfd)(castPtrp_siginfo)sizeof_siginfo_twhen(r/=fromIntegralsizeof_siginfo_t)$errorWithoutStackTrace"failed to read siginfo_t"let!s'=fromIntegralsreturn$CMsgSignalfps'wherewakeupBufferSize=#if defined(HAVE_EVENTFD)8#else4096#endifsendWakeup::Control->IO()#if defined(HAVE_EVENTFD)sendWakeupc=don<-c_eventfd_write(fromIntegral(controlEventFdc))1casenof0->return()_->doerrno<-getErrno-- Check that Control is still alive if we failed, since it's-- possible that someone cleaned up the fds behind our backs and-- consequently eventfd_write failed with EBADF. If it is dead-- then just swallow the error since we are shutting down-- anyways. Otherwise we will see failures during shutdown from-- setnumcapabilities001 (#12038)isDead<-readIORef(controlIsDeadc)ifisDead&&errno==eBADFthenreturn()elsethrowErrno"sendWakeup"#elsesendWakeupc=don<-sendMessage(wakeupWriteFdc)CMsgWakeupcasenof_|n/=-1->return()|otherwise->doerrno<-getErrnowhen(errno/=eAGAIN&&errno/=eWOULDBLOCK)$throwErrno"sendWakeup"#endifsendDie::Control->IO()sendDiec=throwErrnoIfMinus1_"sendDie"$sendMessage(controlWriteFdc)CMsgDiesendMessage::Fd->ControlMessage->IOIntsendMessagefdmsg=alloca$\p->docasemsgofCMsgWakeup->pokepio_MANAGER_WAKEUPCMsgDie->pokepio_MANAGER_DIECMsgSignal_fp_s->errorWithoutStackTrace"Signals can only be sent from within the RTS"fromIntegral`fmap`c_write(fromIntegralfd)p1#if defined(HAVE_EVENTFD)foreignimportccallunsafe"sys/eventfd.h eventfd"c_eventfd::CInt->CInt->IOCIntforeignimportccallunsafe"sys/eventfd.h eventfd_write"c_eventfd_write::CInt->CULLong->IOCInt#endifforeignimportccallunsafe"setIOManagerWakeupFd"c_setIOManagerWakeupFd::CInt->IO()