{-# LANGUAGE CPP #-}-- | Gang Primitives.moduleData.Array.Repa.Eval.Gang(theGang,Gang,forkGang,gangSize,gangIO,gangST)whereimportGHC.IOimportGHC.STimportGHC.Conc(forkOn)importControl.Concurrent.MVarimportControl.Exception(assert)importControl.MonadimportGHC.Conc(numCapabilities)importSystem.IO-- TheGang ---------------------------------------------------------------------- | This globally shared gang is auto-initialised at startup and shared by all-- Repa computations.---- In a data parallel setting, it does not help to have multiple gangs-- running at the same time. This is because a single data parallel-- computation should already be able to keep all threads busy. If we had-- multiple gangs running at the same time, then the system as a whole would-- run slower as the gangs would contend for cache and thrash the scheduler.---- If, due to laziness or otherwise, you try to start multiple parallel-- Repa computations at the same time, then you will get the following-- warning on stderr at runtime:---- @Data.Array.Repa: Performing nested parallel computation sequentially.-- You've probably called the 'compute' or 'copy' function while another-- instance was already running. This can happen if the second version-- was suspended due to lazy evaluation. Use 'deepSeqArray' to ensure that-- each array is fully evaluated before you 'compute' the next one.-- @--theGang::Gang{-# NOINLINE theGang #-}theGang=unsafePerformIO$doletcaps=numCapabilitiesforkGangcaps-- Requests --------------------------------------------------------------------- | The 'Req' type encapsulates work requests for individual members of a gang.dataReq-- | Instruct the worker to run the given action.=ReqDo(Int->IO())-- | Tell the worker that we're shutting the gang down.-- The worker should signal that it's receieved the request by-- writing to its result var before returning to the caller (forkGang).|ReqShutdown-- Gang ------------------------------------------------------------------------- | A 'Gang' is a group of threads that execute arbitrary work requests.dataGang=Gang{-- | Number of threads in the gang._gangThreads::!Int-- | Workers listen for requests on these vars.,_gangRequestVars::[MVarReq]-- | Workers put their results in these vars.,_gangResultVars::[MVar()]-- | Indicates that the gang is busy.,_gangBusy::MVarBool}instanceShowGangwhereshowsPrecp(Gangn___)=showString"<<".showsPrecpn.showString" threads>>"-- | O(1). Yield the number of threads in the 'Gang'.gangSize::Gang->IntgangSize(Gangn___)=n-- | Fork a 'Gang' with the given number of threads (at least 1).forkGang::Int->IOGangforkGangn=assert(n>0)$do-- Create the vars we'll use to issue work requests.mvsRequest<-sequence$replicaten$newEmptyMVar-- Create the vars we'll use to signal that threads are done.mvsDone<-sequence$replicaten$newEmptyMVar-- Add finalisers so we can shut the workers down cleanly if they-- become unreachable.zipWithM_(\varReqvarDone->addMVarFinalizervarReq(finaliseWorkervarReqvarDone))mvsRequestmvsDone-- Create all the worker threadszipWithM_forkOn[0..]$zipWith3gangWorker[0..n-1]mvsRequestmvsDone-- The gang is currently idle.busy<-newMVarFalsereturn$GangnmvsRequestmvsDonebusy-- | The worker thread of a 'Gang'.-- The threads blocks on the MVar waiting for a work request.gangWorker::Int->MVarReq->MVar()->IO()gangWorkerthreadIdvarRequestvarDone=do-- Wait for a request req<-takeMVarvarRequestcasereqofReqDoaction->do-- Run the action we were given.actionthreadId-- Signal that the action is complete.putMVarvarDone()-- Wait for more requests.gangWorkerthreadIdvarRequestvarDoneReqShutdown->putMVarvarDone()-- | Finaliser for worker threads.-- We want to shutdown the corresponding thread when it's MVar becomes-- unreachable.-- Without this Repa programs can complain about "Blocked indefinitely-- on an MVar" because worker threads are still blocked on the request-- MVars when the program ends. Whether the finalizer is called or not-- is very racey. It happens about 1 in 10 runs when for the-- repa-edgedetect benchmark, and less often with the others.---- We're relying on the comment in System.Mem.Weak that says-- "If there are no other threads to run, the runtime system will-- check for runnablefinalizers before declaring the system to be-- deadlocked."---- If we were creating and destroying the gang cleanly we wouldn't need-- this, but theGang is created with a top-level unsafePerformIO.-- Hacks beget hacks beget hacks...--finaliseWorker::MVarReq->MVar()->IO()finaliseWorkervarReqvarDone=doputMVarvarReqReqShutdowntakeMVarvarDonereturn()-- | Issue work requests for the 'Gang' and wait until they complete.---- If the gang is already busy then print a warning to `stderr` and just-- run the actions sequentially in the requesting thread.gangIO::Gang->(Int->IO())->IO(){-# NOINLINE gangIO #-}gangIOgang@(Gang___busy)action=dob<-swapMVarbusyTrueifbthendoseqIOgangactionelsedoparIOgangaction_<-swapMVarbusyFalsereturn()-- | Run an action on the gang sequentially.seqIO::Gang->(Int->IO())->IO()seqIO(Gangn___)action=dohPutStrstderr$unlines["Data.Array.Repa: Performing nested parallel computation sequentially."," You've probably called the 'compute' or 'copy' function while another"," instance was already running. This can happen if the second version"," was suspended due to lazy evaluation. Use 'deepSeqArray' to ensure"," that each array is fully evaluated before you 'compute' the next one.",""]mapM_action[0..n-1]-- | Run an action on the gang in parallel.parIO::Gang->(Int->IO())->IO()parIO(Gang_mvsRequestmvsResult_)action=do-- Send requests to all the threads.mapM_(\v->putMVarv(ReqDoaction))mvsRequest-- Wait for all the requests to complete.mapM_takeMVarmvsResult-- | Same as 'gangIO' but in the 'ST' monad.gangST::Gang->(Int->STs())->STs()gangSTgp=unsafeIOToST.gangIOg$unsafeSTToIO.p