Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE BangPatterns           , CPP           , ExistentialQuantification           , NoImplicitPrelude           , RecordWildCards           , TypeSynonymInstances           , FlexibleInstances  #-}-- |-- The event manager supports event notification on fds. Each fd may-- have multiple callbacks registered, each listening for a different-- set of events. Registrations may be automatically deactivated after-- the occurrence of an event ("one-shot mode") or active until-- explicitly unregistered.---- If an fd has only one-shot registrations then we use one-shot-- polling if available. Otherwise we use multi-shot polling.moduleGHC.Event.Manager(-- * TypesEventManager-- * Creation,new,newWith,newDefaultBackend-- * Running,finished,loop,step,shutdown,release,cleanup,wakeManager-- * State,callbackTableVar,emControl-- * Registering interest in I/O events,Lifetime(..),Event,evtRead,evtWrite,IOCallback,FdKey(keyFd),FdData,registerFd,unregisterFd_,unregisterFd,closeFd,closeFd_)where#include "EventConfig.h"-------------------------------------------------------------------------- ImportsimportControl.Concurrent.MVar(MVar,newMVar,putMVar,tryPutMVar,takeMVar,withMVar)importControl.Exception(onException)importData.Bits((.&.))importData.Foldable(forM_)importData.Functor(void)importData.IORef(IORef,atomicModifyIORef',mkWeakIORef,newIORef,readIORef,writeIORef)importData.Maybe(maybe)importData.OldList(partition)importGHC.Arr(Array,(!),listArray)importGHC.BaseimportGHC.Conc.Sync(yield)importGHC.List(filter,replicate)importGHC.Num(Num(..))importGHC.Real(fromIntegral)importGHC.Show(Show(..))importGHC.Event.ControlimportGHC.Event.IntTable(IntTable)importGHC.Event.Internal(Backend,Event,evtClose,evtRead,evtWrite,Lifetime(..),EventLifetime,Timeout(..))importGHC.Event.Unique(Unique,UniqueSource,newSource,newUnique)importSystem.Posix.Types(Fd)importqualifiedGHC.Event.IntTableasITimportqualifiedGHC.Event.InternalasI#if defined(HAVE_KQUEUE)importqualifiedGHC.Event.KQueueasKQueue#elif defined(HAVE_EPOLL)importqualifiedGHC.Event.EPollasEPoll#elif defined(HAVE_POLL)importqualifiedGHC.Event.PollasPoll#else# error not implemented for this operating system#endif-------------------------------------------------------------------------- TypesdataFdData=FdData{fdKey::{-# UNPACK#-}!FdKey,fdEvents::{-# UNPACK#-}!EventLifetime,_fdCallback::!IOCallback}-- | A file descriptor registration cookie.dataFdKey=FdKey{keyFd::{-# UNPACK#-}!Fd,keyUnique::{-# UNPACK#-}!Unique}deriving(Eq-- ^ @since 4.4.0.0,Show-- ^ @since 4.4.0.0)-- | Callback invoked on I/O events.typeIOCallback=FdKey->Event->IO()dataState=Created|Running|Dying|Releasing|Finishedderiving(Eq-- ^ @since 4.4.0.0,Show-- ^ @since 4.4.0.0)-- | The event manager state.dataEventManager=EventManager{emBackend::!Backend,emFds::{-# UNPACK#-}!(ArrayInt(MVar(IntTable[FdData]))),emState::{-# UNPACK#-}!(IORefState),emUniqueSource::{-# UNPACK#-}!UniqueSource,emControl::{-# UNPACK#-}!Control,emLock::{-# UNPACK#-}!(MVar())}-- must be power of 2callbackArraySize::IntcallbackArraySize=32hashFd::Fd->InthashFdfd=fromIntegralfd.&.(callbackArraySize-1){-# INLINEhashFd#-}callbackTableVar::EventManager->Fd->MVar(IntTable[FdData])callbackTableVarmgrfd=emFdsmgr!hashFdfd{-# INLINEcallbackTableVar#-}haveOneShot::Bool{-# INLINEhaveOneShot#-}#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)haveOneShot=False#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)haveOneShot=True#elsehaveOneShot=False#endif-------------------------------------------------------------------------- CreationhandleControlEvent::EventManager->Fd->Event->IO()handleControlEventmgrfd_evt=domsg<-readControlMessage(emControlmgr)fdcasemsgofCMsgWakeup->return()CMsgDie->writeIORef(emStatemgr)Finished_->return()newDefaultBackend::IOBackend#if defined(HAVE_KQUEUE)newDefaultBackend=KQueue.new#elif defined(HAVE_EPOLL)newDefaultBackend=EPoll.new#elif defined(HAVE_POLL)newDefaultBackend=Poll.new#elsenewDefaultBackend=errorWithoutStackTrace"no back end for this platform"#endif-- | Create a new event manager.new::IOEventManagernew=newWith=<<newDefaultBackend-- | Create a new 'EventManager' with the given polling backend.newWith::Backend->IOEventManagernewWithbe=doiofds<-fmap(listArray(0,callbackArraySize-1))$replicateMcallbackArraySize(newMVar=<<IT.new8)ctrl<-newControlFalsestate<-newIORefCreatedus<-newSource_<-mkWeakIORefstate$dost<-atomicModifyIORef'state$\s->(Finished,s)when(st/=Finished)$doI.deletebecloseControlctrllockVar<-newMVar()letmgr=EventManager{emBackend=be,emFds=iofds,emState=state,emUniqueSource=us,emControl=ctrl,emLock=lockVar}registerControlFdmgr(controlReadFdctrl)evtReadregisterControlFdmgr(wakeupReadFdctrl)evtReadreturnmgrwherereplicateMnx=sequence(replicatenx)failOnInvalidFile::String->Fd->IOBool->IO()failOnInvalidFilelocfdm=dook<-mwhen(notok)$letmsg="Failed while attempting to modify registration of file "++showfd++" at location "++locinerrorWithoutStackTracemsgregisterControlFd::EventManager->Fd->Event->IO()registerControlFdmgrfdevs=failOnInvalidFile"registerControlFd"fd$I.modifyFd(emBackendmgr)fdmemptyevs-- | Asynchronously shuts down the event manager, if running.shutdown::EventManager->IO()shutdownmgr=dostate<-atomicModifyIORef'(emStatemgr)$\s->(Dying,s)when(state==Running)$sendDie(emControlmgr)-- | Asynchronously tell the thread executing the event-- manager loop to exit.release::EventManager->IO()releaseEventManager{..}=dostate<-atomicModifyIORef'emState$\s->(Releasing,s)when(state==Running)$sendWakeupemControlfinished::EventManager->IOBoolfinishedmgr=(==Finished)`liftM`readIORef(emStatemgr)cleanup::EventManager->IO()cleanupEventManager{..}=dowriteIORefemStateFinishedvoid$tryPutMVaremLock()I.deleteemBackendcloseControlemControl-------------------------------------------------------------------------- Event loop-- | Start handling events.  This function loops until told to stop,-- using 'shutdown'.---- /Note/: This loop can only be run once per 'EventManager', as it-- closes all of its control resources when it finishes.loop::EventManager->IO()loopmgr@EventManager{..}=dovoid$takeMVaremLockstate<-atomicModifyIORef'emState$\s->casesofCreated->(Running,s)Releasing->(Running,s)_->(s,s)casestateofCreated->go`onException`cleanupmgrReleasing->go`onException`cleanupmgrDying->cleanupmgr-- While a poll loop is never forked when the event manager is in the-- 'Finished' state, its state could read 'Finished' once the new thread-- actually runs.  This is not an error, just an unfortunate race condition-- in Thread.restartPollLoop.  See #8235Finished->return()_->docleanupmgrerrorWithoutStackTrace$"GHC.Event.Manager.loop: state is already "++showstatewherego=dostate<-stepmgrcasestateofRunning->yield>>goReleasing->putMVaremLock()_->cleanupmgr-- | To make a step, we first do a non-blocking poll, in case-- there are already events ready to handle. This improves performance-- because we can make an unsafe foreign C call, thereby avoiding-- forcing the current Task to release the Capability and forcing a context switch.-- If the poll fails to find events, we yield, putting the poll loop thread at-- end of the Haskell run queue. When it comes back around, we do one more-- non-blocking poll, in case we get lucky and have ready events.-- If that also returns no events, then we do a blocking poll.step::EventManager->IOStatestepmgr@EventManager{..}=dowaitForIOstate<-readIORefemStatestate`seq`returnstatewherewaitForIO=don1<-I.pollemBackendNothing(onFdEventmgr)when(n1<=0)$doyieldn2<-I.pollemBackendNothing(onFdEventmgr)when(n2<=0)$do_<-I.pollemBackend(JustForever)(onFdEventmgr)return()-------------------------------------------------------------------------- Registering interest in I/O events-- | Register interest in the given events, without waking the event-- manager thread.  The 'Bool' return value indicates whether the-- event manager ought to be woken.---- Note that the event manager is generally implemented in terms of the-- platform's @select@ or @epoll@ system call, which tend to vary in-- what sort of fds are permitted. For instance, waiting on regular files-- is not allowed on many platforms.registerFd_::EventManager->IOCallback->Fd->Event->Lifetime->IO(FdKey,Bool)registerFd_mgr@(EventManager{..})cbfdevslt=dou<-newUniqueemUniqueSourceletfd'=fromIntegralfdreg=FdKeyfduel=I.eventLifetimeevslt!fdd=FdDataregelcb(modify,ok)<-withMVar(callbackTableVarmgrfd)$\tbl->dooldFdd<-IT.insertWith(++)fd'[fdd]tblletprevEvs::EventLifetimeprevEvs=maybememptyeventsOfoldFddel'::EventLifetimeel'=prevEvs`mappend`elcaseI.elLifetimeel'of-- All registrations want one-shot semantics and this is supportedOneShot|haveOneShot->dook<-I.modifyFdOnceemBackendfd(I.elEventel')ifokthenreturn(False,True)elseIT.resetfd'oldFddtbl>>return(False,False)-- We don't want or don't support one-shot semantics_->doletmodify=prevEvs/=el'ok<-ifmodifythenletnewEvs=I.elEventel'oldEvs=I.elEventprevEvsinI.modifyFdemBackendfdoldEvsnewEvselsereturnTrueifokthenreturn(modify,True)elseIT.resetfd'oldFddtbl>>return(False,False)-- this simulates behavior of old IO manager:-- i.e. just call the callback if the registration fails.when(notok)(cbregevs)return(reg,modify){-# INLINEregisterFd_#-}-- | @registerFd mgr cb fd evs lt@ registers interest in the events @evs@-- on the file descriptor @fd@ for lifetime @lt@. @cb@ is called for-- each event that occurs.  Returns a cookie that can be handed to-- 'unregisterFd'.registerFd::EventManager->IOCallback->Fd->Event->Lifetime->IOFdKeyregisterFdmgrcbfdevslt=do(r,wake)<-registerFd_mgrcbfdevsltwhenwake$wakeManagermgrreturnr{-# INLINEregisterFd#-}{-    Building GHC with parallel IO manager on Mac freezes when    compiling the dph libraries in the phase 2. As workaround, we    don't use oneshot and we wake up an IO manager on Mac every time    when we register an event.    For more information, please read:        http://ghc.haskell.org/trac/ghc/ticket/7651-}-- | Wake up the event manager.wakeManager::EventManager->IO()#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)wakeManagermgr=sendWakeup(emControlmgr)#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)wakeManager_=return()#elsewakeManagermgr=sendWakeup(emControlmgr)#endifeventsOf::[FdData]->EventLifetimeeventsOf[fdd]=fdEventsfddeventsOffdds=mconcat$mapfdEventsfdds-- | Drop a previous file descriptor registration, without waking the-- event manager thread.  The return value indicates whether the event-- manager ought to be woken.unregisterFd_::EventManager->FdKey->IOBoolunregisterFd_mgr@(EventManager{..})(FdKeyfdu)=withMVar(callbackTableVarmgrfd)$\tbl->doletdropReg=nullToNothing.filter((/=u).keyUnique.fdKey)fd'=fromIntegralfdpairEvents::[FdData]->IO(EventLifetime,EventLifetime)pairEventsprev=dor<-maybememptyeventsOf`fmap`IT.lookupfd'tblreturn(eventsOfprev,r)(oldEls,newEls)<-IT.updateWithdropRegfd'tbl>>=maybe(return(mempty,mempty))pairEventsletmodify=oldEls/=newElswhenmodify$failOnInvalidFile"unregisterFd_"fd$caseI.elLifetimenewElsofOneShot|I.elEventnewEls/=mempty,haveOneShot->I.modifyFdOnceemBackendfd(I.elEventnewEls)_->I.modifyFdemBackendfd(I.elEventoldEls)(I.elEventnewEls)returnmodify-- | Drop a previous file descriptor registration.unregisterFd::EventManager->FdKey->IO()unregisterFdmgrreg=dowake<-unregisterFd_mgrregwhenwake$wakeManagermgr-- | Close a file descriptor in a race-safe way.closeFd::EventManager->(Fd->IO())->Fd->IO()closeFdmgrclosefd=dofds<-withMVar(callbackTableVarmgrfd)$\tbl->doprev<-IT.delete(fromIntegralfd)tblcaseprevofNothing->closefd>>return[]Justfds->doletoldEls=eventsOffdswhen(I.elEventoldEls/=mempty)$do_<-I.modifyFd(emBackendmgr)fd(I.elEventoldEls)memptywakeManagermgrclosefdreturnfdsforM_fds$\(FdDataregelcb)->cbreg(I.elEventel`mappend`evtClose)-- | Close a file descriptor in a race-safe way.-- It assumes the caller will update the callback tables and that the caller-- holds the callback table lock for the fd. It must hold this lock because-- this command executes a backend command on the fd.closeFd_::EventManager->IntTable[FdData]->Fd->IO(IO())closeFd_mgrtblfd=doprev<-IT.delete(fromIntegralfd)tblcaseprevofNothing->return(return())Justfds->doletoldEls=eventsOffdswhen(oldEls/=mempty)$do_<-I.modifyFd(emBackendmgr)fd(I.elEventoldEls)memptywakeManagermgrreturn$forM_fds$\(FdDataregelcb)->cbreg(I.elEventel`mappend`evtClose)-------------------------------------------------------------------------- Utilities-- | Call the callbacks corresponding to the given file descriptor.onFdEvent::EventManager->Fd->Event->IO()onFdEventmgrfdevs|fd==controlReadFd(emControlmgr)||fd==wakeupReadFd(emControlmgr)=handleControlEventmgrfdevs|otherwise=dofdds<-withMVar(callbackTableVarmgrfd)$\tbl->IT.delete(fromIntegralfd)tbl>>=maybe(return[])(selectCallbackstbl)forM_fdds$\(FdDatareg_cb)->cbregevswhere-- | Here we look through the list of registrations for the fd of interest-- and sort out which match the events that were triggered. We,----   1. re-arm the fd as appropriate--   2. reinsert registrations that weren't triggered and multishot--      registrations--   3. return a list containing the callbacks that should be invoked.selectCallbacks::IntTable[FdData]->[FdData]->IO[FdData]selectCallbackstblfdds=dolet-- figure out which registrations have been triggeredmatches::FdData->Boolmatchesfd'=evs`I.eventIs`I.elEvent(fdEventsfd')(triggered,notTriggered)=partitionmatchesfdds-- sort out which registrations we need to retainisMultishot::FdData->BoolisMultishotfd'=I.elLifetime(fdEventsfd')==MultiShotsaved=notTriggered++filterisMultishottriggeredsavedEls=eventsOfsavedallEls=eventsOffdds-- Reinsert multishot registrations.-- We deleted the table entry for this fd above so we there isn't a preexisting entry_<-IT.insertWith(\__->saved)(fromIntegralfd)savedtblcaseI.elLifetimeallElsof-- we previously armed the fd for multiple shots, no need to rearmMultiShot|allEls==savedEls->return()-- either we previously registered for one shot or the-- events of interest have changed, we must re-arm_->caseI.elLifetimesavedElsofOneShot|haveOneShot->-- if there are no saved events and we registered with one-shot-- semantics then there is no need to re-armunless(OneShot==I.elLifetimeallEls&&mempty==I.elEventsavedEls)$dovoid$I.modifyFdOnce(emBackendmgr)fd(I.elEventsavedEls)_->-- we need to re-arm with multi-shot semanticsvoid$I.modifyFd(emBackendmgr)fd(I.elEventallEls)(I.elEventsavedEls)returntriggerednullToNothing::[a]->Maybe[a]nullToNothing[]=NothingnullToNothingxs@(_:_)=Justxsunless::Monadm=>Bool->m()->m()unlessp=when(notp)