Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}moduleGHC.Event.Thread(getSystemEventManager,getSystemTimerManager,ensureIOManagerIsRunning,ioManagerCapabilitiesChanged,threadWaitRead,threadWaitWrite,threadWaitReadSTM,threadWaitWriteSTM,closeFdWith,threadDelay,registerDelay,blockedOnBadFD-- used by RTS)whereimportControl.Exception(finally,SomeException,toException)importData.Foldable(forM_,mapM_,sequence_)importData.IORef(IORef,newIORef,readIORef,writeIORef)importData.Tuple(snd)importForeign.C.Error(eBADF,errnoToIOError)importForeign.C.Types(CInt(..),CUInt(..))importForeign.Ptr(Ptr)importGHC.BaseimportGHC.List(zipWith,zipWith3)importGHC.Conc.Sync(TVar,ThreadId,ThreadStatus(..),atomically,forkIO,labelThread,modifyMVar_,withMVar,newTVar,sharedCAF,getNumCapabilities,threadCapability,myThreadId,forkOn,threadStatus,writeTVar,newTVarIO,readTVar,retry,throwSTM,STM)importGHC.IO(mask_,onException)importGHC.IO.Exception(ioError)importGHC.IOArray(IOArray,newIOArray,readIOArray,writeIOArray,boundsIOArray)importGHC.MVar(MVar,newEmptyMVar,newMVar,putMVar,takeMVar)importGHC.Event.Control(controlWriteFd)importGHC.Event.Internal(eventIs,evtClose)importGHC.Event.Manager(Event,EventManager,evtRead,evtWrite,loop,new,registerFd,unregisterFd_)importqualifiedGHC.Event.ManagerasMimportqualifiedGHC.Event.TimerManagerasTMimportGHC.Num((-),(+))importGHC.Real(fromIntegral)importGHC.Show(showSignedInt)importSystem.IO.Unsafe(unsafePerformIO)importSystem.Posix.Types(Fd)-- | Suspends the current thread for a given number of microseconds-- (GHC only).---- There is no guarantee that the thread will be rescheduled promptly-- when the delay has expired, but the thread will never continue to-- run /earlier/ than specified.threadDelay::Int->IO()threadDelayusecs=mask_$domgr<-getSystemTimerManagerm<-newEmptyMVarreg<-TM.registerTimeoutmgrusecs(putMVarm())takeMVarm`onException`TM.unregisterTimeoutmgrreg-- | Set the value of returned TVar to True after a given number of-- microseconds. The caveats associated with threadDelay also apply.--registerDelay::Int->IO(TVarBool)registerDelayusecs=dot<-atomically$newTVarFalsemgr<-getSystemTimerManager_<-TM.registerTimeoutmgrusecs.atomically$writeTVartTruereturnt-- | Block the current thread until data is available to read from the-- given file descriptor.---- This will throw an 'IOError' if the file descriptor was closed-- while this thread was blocked.  To safely close a file descriptor-- that has been used with 'threadWaitRead', use 'closeFdWith'.threadWaitRead::Fd->IO()threadWaitRead=threadWaitevtRead{-# INLINEthreadWaitRead#-}-- | Block the current thread until the given file descriptor can-- accept data to write.---- This will throw an 'IOError' if the file descriptor was closed-- while this thread was blocked.  To safely close a file descriptor-- that has been used with 'threadWaitWrite', use 'closeFdWith'.threadWaitWrite::Fd->IO()threadWaitWrite=threadWaitevtWrite{-# INLINEthreadWaitWrite#-}-- | Close a file descriptor in a concurrency-safe way.---- Any threads that are blocked on the file descriptor via-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having-- IO exceptions thrown.closeFdWith::(Fd->IO())-- ^ Action that performs the close.->Fd-- ^ File descriptor to close.->IO()closeFdWithclosefd=doeventManagerArray<-readIORefeventManagerlet(low,high)=boundsIOArrayeventManagerArraymgrs<-flipmapM[low..high]$\i->doJust(_,!mgr)<-readIOArrayeventManagerArrayireturnmgrmask_$dotables<-flipmapMmgrs$\mgr->takeMVar$M.callbackTableVarmgrfdcbApps<-zipWithM(\mgrtable->M.closeFd_mgrtablefd)mgrstablesclosefd`finally`sequence_(zipWith3finishmgrstablescbApps)wherefinishmgrtablecbApp=putMVar(M.callbackTableVarmgrfd)table>>cbAppzipWithMfxsys=sequence(zipWithfxsys)threadWait::Event->Fd->IO()threadWaitevtfd=mask_$dom<-newEmptyMVarmgr<-getSystemEventManager_reg<-registerFdmgr(\_e->putMVarme)fdevtM.OneShotevt'<-takeMVarm`onException`unregisterFd_mgrregifevt'`eventIs`evtClosethenioError$errnoToIOError"threadWait"eBADFNothingNothingelsereturn()-- used at least by RTS in 'select()' IO manager backendblockedOnBadFD::SomeExceptionblockedOnBadFD=toException$errnoToIOError"awaitEvent"eBADFNothingNothingthreadWaitSTM::Event->Fd->IO(STM(),IO())threadWaitSTMevtfd=mask_$dom<-newTVarIONothingmgr<-getSystemEventManager_reg<-registerFdmgr(\_e->atomically(writeTVarm(Juste)))fdevtM.OneShotletwaitAction=domevt<-readTVarmcasemevtofNothing->retryJustevt'->ifevt'`eventIs`evtClosethenthrowSTM$errnoToIOError"threadWaitSTM"eBADFNothingNothingelsereturn()return(waitAction,unregisterFd_mgrreg>>return())-- | Allows a thread to use an STM action to wait for a file descriptor to be readable.-- The STM action will retry until the file descriptor has data ready.-- The second element of the return value pair is an IO action that can be used-- to deregister interest in the file descriptor.---- The STM action will throw an 'IOError' if the file descriptor was closed-- while the STM action is being executed.  To safely close a file descriptor-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'.threadWaitReadSTM::Fd->IO(STM(),IO())threadWaitReadSTM=threadWaitSTMevtRead{-# INLINEthreadWaitReadSTM#-}-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write.-- The STM action will retry while the file until the given file descriptor can accept a write.-- The second element of the return value pair is an IO action that can be used to deregister-- interest in the file descriptor.---- The STM action will throw an 'IOError' if the file descriptor was closed-- while the STM action is being executed.  To safely close a file descriptor-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'.threadWaitWriteSTM::Fd->IO(STM(),IO())threadWaitWriteSTM=threadWaitSTMevtWrite{-# INLINEthreadWaitWriteSTM#-}-- | Retrieve the system event manager for the capability on which the-- calling thread is running.---- This function always returns 'Just' the current thread's event manager-- when using the threaded RTS and 'Nothing' otherwise.getSystemEventManager::IO(MaybeEventManager)getSystemEventManager=dot<-myThreadId(cap,_)<-threadCapabilityteventManagerArray<-readIORefeventManagermmgr<-readIOArrayeventManagerArraycapreturn$fmapsndmmgrgetSystemEventManager_::IOEventManagergetSystemEventManager_=doJustmgr<-getSystemEventManagerreturnmgr{-# INLINEgetSystemEventManager_#-}foreignimportccallunsafe"getOrSetSystemEventThreadEventManagerStore"getOrSetSystemEventThreadEventManagerStore::Ptra->IO(Ptra)eventManager::IORef(IOArrayInt(Maybe(ThreadId,EventManager)))eventManager=unsafePerformIO$donumCaps<-getNumCapabilitieseventManagerArray<-newIOArray(0,numCaps-1)Nothingem<-newIORefeventManagerArraysharedCAFemgetOrSetSystemEventThreadEventManagerStore{-# NOINLINEeventManager#-}numEnabledEventManagers::IORefIntnumEnabledEventManagers=unsafePerformIO$donewIORef0{-# NOINLINEnumEnabledEventManagers#-}foreignimportccallunsafe"getOrSetSystemEventThreadIOManagerThreadStore"getOrSetSystemEventThreadIOManagerThreadStore::Ptra->IO(Ptra)-- | The ioManagerLock protects the 'eventManager' value:-- Only one thread at a time can start or shutdown event managers.{-# NOINLINEioManagerLock#-}ioManagerLock::MVar()ioManagerLock=unsafePerformIO$dom<-newMVar()sharedCAFmgetOrSetSystemEventThreadIOManagerThreadStoregetSystemTimerManager::IOTM.TimerManagergetSystemTimerManager=doJustmgr<-readIOReftimerManagerreturnmgrforeignimportccallunsafe"getOrSetSystemTimerThreadEventManagerStore"getOrSetSystemTimerThreadEventManagerStore::Ptra->IO(Ptra)timerManager::IORef(MaybeTM.TimerManager)timerManager=unsafePerformIO$doem<-newIORefNothingsharedCAFemgetOrSetSystemTimerThreadEventManagerStore{-# NOINLINEtimerManager#-}foreignimportccallunsafe"getOrSetSystemTimerThreadIOManagerThreadStore"getOrSetSystemTimerThreadIOManagerThreadStore::Ptra->IO(Ptra){-# NOINLINEtimerManagerThreadVar#-}timerManagerThreadVar::MVar(MaybeThreadId)timerManagerThreadVar=unsafePerformIO$dom<-newMVarNothingsharedCAFmgetOrSetSystemTimerThreadIOManagerThreadStoreensureIOManagerIsRunning::IO()ensureIOManagerIsRunning|notthreaded=return()|otherwise=dostartIOManagerThreadsstartTimerManagerThreadstartIOManagerThreads::IO()startIOManagerThreads=withMVarioManagerLock$\_->doeventManagerArray<-readIORefeventManagerlet(_,high)=boundsIOArrayeventManagerArraymapM_(startIOManagerThreadeventManagerArray)[0..high]writeIORefnumEnabledEventManagers(high+1)show_int::Int->Stringshow_inti=showSignedInt0i""restartPollLoop::EventManager->Int->IOThreadIdrestartPollLoopmgri=doM.releasemgr!t<-forkOni$loopmgrlabelThreadt("IOManager on cap "++show_inti)returntstartIOManagerThread::IOArrayInt(Maybe(ThreadId,EventManager))->Int->IO()startIOManagerThreadeventManagerArrayi=doletcreate=do!mgr<-new!t<-forkOni$doc_setIOManagerControlFd(fromIntegrali)(fromIntegral$controlWriteFd$M.emControlmgr)loopmgrlabelThreadt("IOManager on cap "++show_inti)writeIOArrayeventManagerArrayi(Just(t,mgr))old<-readIOArrayeventManagerArrayicaseoldofNothing->createJust(t,em)->dos<-threadStatustcasesofThreadFinished->createThreadDied->do-- Sanity check: if the thread has died, there is a chance-- that event manager is still alive. This could happend during-- the fork, for example. In this case we should clean up-- open pipes and everything else related to the event manager.-- See #4449c_setIOManagerControlFd(fromIntegrali)(-1)M.cleanupemcreate_other->return()startTimerManagerThread::IO()startTimerManagerThread=modifyMVar_timerManagerThreadVar$\old->doletcreate=do!mgr<-TM.newc_setTimerManagerControlFd(fromIntegral$controlWriteFd$TM.emControlmgr)writeIOReftimerManager$Justmgr!t<-forkIO$TM.loopmgrlabelThreadt"TimerManager"return$JusttcaseoldofNothing->createst@(Justt)->dos<-threadStatustcasesofThreadFinished->createThreadDied->do-- Sanity check: if the thread has died, there is a chance-- that event manager is still alive. This could happend during-- the fork, for example. In this case we should clean up-- open pipes and everything else related to the event manager.-- See #4449mem<-readIOReftimerManager_<-casememofNothing->return()Justem->doc_setTimerManagerControlFd(-1)TM.cleanupemcreate_other->returnstforeignimportccallunsafe"rtsSupportsBoundThreads"threaded::BoolioManagerCapabilitiesChanged::IO()ioManagerCapabilitiesChanged=dowithMVarioManagerLock$\_->donew_n_caps<-getNumCapabilitiesnumEnabled<-readIORefnumEnabledEventManagerswriteIORefnumEnabledEventManagersnew_n_capseventManagerArray<-readIORefeventManagerlet(_,high)=boundsIOArrayeventManagerArrayletold_n_caps=high+1ifnew_n_caps>old_n_capsthendonew_eventManagerArray<-newIOArray(0,new_n_caps-1)Nothing-- copy the existing values into the new array:forM_[0..high]$\i->doJust(tid,mgr)<-readIOArrayeventManagerArrayiifi<numEnabledthenwriteIOArraynew_eventManagerArrayi(Just(tid,mgr))elsedotid'<-restartPollLoopmgriwriteIOArraynew_eventManagerArrayi(Just(tid',mgr))-- create new IO managers for the new caps:forM_[old_n_caps..new_n_caps-1]$startIOManagerThreadnew_eventManagerArray-- update the event manager array reference:writeIORefeventManagernew_eventManagerArrayelsewhen(new_n_caps>numEnabled)$forM_[numEnabled..new_n_caps-1]$\i->doJust(_,mgr)<-readIOArrayeventManagerArrayitid<-restartPollLoopmgriwriteIOArrayeventManagerArrayi(Just(tid,mgr))-- Used to tell the RTS how it can send messages to the I/O manager.foreignimportccallunsafe"setIOManagerControlFd"c_setIOManagerControlFd::CUInt->CInt->IO()foreignimportccallunsafe"setTimerManagerControlFd"c_setTimerManagerControlFd::CInt->IO()