@@ -347,7 +347,7 @@ data SVar t m a = SVar
347347 , enqueue :: t m a -> IO ()
348348 , isWorkDone :: IO Bool
349349 , needDoorBell :: IORef Bool
350− , workLoop :: WorkerInfo -> m ()
350+ , workLoop :: Maybe WorkerInfo -> m ()
351351
352352 -- Shared, thread tracking
353353 , workerThreads :: IORef (Set ThreadId)
@@ -905,13 +905,16 @@ workerRateControl sv yinfo winfo = do
905905-- streams. latency update must be done when we yield directly to outputQueue
906906-- or when we yield to heap.
907907{-# INLINE sendYield #-}
908−sendYield :: SVar t m a -> WorkerInfo -> ChildEvent a -> IO Bool
909−sendYield sv winfo msg = do
908+sendYield :: SVar t m a -> Maybe WorkerInfo -> ChildEvent a -> IO Bool
909+sendYield sv mwinfo msg = do
910910 r <- send sv msg
911911 rateLimitOk <-
912− case yieldRateInfo sv of
912+ case mwinfo of
913+ Just winfo ->
914+ case yieldRateInfo sv of
915+ Nothing -> return True
916+ Just yinfo -> workerRateControl sv yinfo winfo
913917 Nothing -> return True
914− Just yinfo -> workerRateControl sv yinfo winfo
915918 return $ r && rateLimitOk
916919
917920{-# INLINE workerStopUpdate #-}
@@ -921,12 +924,15 @@ workerStopUpdate winfo info = do
921924 when (i /= 0) $ workerUpdateLatency info winfo
922925
923926{-# INLINABLE sendStop #-}
924−sendStop :: SVar t m a -> WorkerInfo -> IO ()
925−sendStop sv winfo = do
927+sendStop :: SVar t m a -> Maybe WorkerInfo -> IO ()
928+sendStop sv mwinfo = do
926929 atomicModifyIORefCAS_ (workerCount sv) $ \n -> n - 1
927− case yieldRateInfo sv of
930+ case mwinfo of
931+ Just winfo ->
932+ case yieldRateInfo sv of
933+ Nothing -> return ()
934+ Just info -> workerStopUpdate winfo info
928935 Nothing -> return ()
929− Just info -> workerStopUpdate winfo info
930936 myThreadId >>= \tid -> void $ send sv (ChildStop tid Nothing)
931937
932938-------------------------------------------------------------------------------
@@ -1193,17 +1199,20 @@ pushWorker yieldMax sv = do
11931199#ifdef DIAGNOSTICS
11941200 recordMaxWorkers sv
11951201#endif
1196− -- XXX we can make this allocation conditional, it might matter when
1197− -- significant number of workers are being sent.
1198− winfo <- do
1199− cntRef <- liftIO $ newIORef 0
1200− t <- liftIO $ getTime Monotonic
1201− lat <- liftIO $ newIORef (0, t)
1202− return $ WorkerInfo
1203− { workerYieldMax = yieldMax
1204− , workerYieldCount = cntRef
1205− , workerLatencyStart = lat
1206− }
1202+ -- This allocation matters when significant number of workers are being
1203+ -- sent. We allocate it only when needed.
1204+ winfo <-
1205+ case yieldRateInfo sv of
1206+ Nothing -> return Nothing
1207+ Just _ -> liftIO $ do
1208+ cntRef <- newIORef 0
1209+ t <- getTime Monotonic
1210+ lat <- newIORef (0, t)
1211+ return $ Just $ WorkerInfo
1212+ { workerYieldMax = yieldMax
1213+ , workerYieldCount = cntRef
1214+ , workerLatencyStart = lat
1215+ }
12071216 doFork (workLoop sv winfo) (handleChildException sv) >>= addThread sv
12081217
12091218-- XXX we can push the workerCount modification in accountThread and use the
@@ -1215,25 +1224,32 @@ pushWorker yieldMax sv = do
12151224-- workerThreads. Alternatively, we can use a CreateThread event to avoid
12161225-- using a CAS based modification.
12171226{-# NOINLINE pushWorkerPar #-}
1218−pushWorkerPar :: MonadAsync m => SVar t m a -> (WorkerInfo -> m ()) -> m ()
1227+pushWorkerPar :: MonadAsync m => SVar t m a -> (Maybe WorkerInfo -> m ()) -> m ()
12191228pushWorkerPar sv wloop = do
12201229 -- We do not use workerCount in case of ParallelVar but still there is no
12211230 -- harm in maintaining it correctly.
12221231#ifdef DIAGNOSTICS
12231232 liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1
12241233 recordMaxWorkers sv
1225−#endif
1226− winfo <- do
1227− cntRef <- liftIO $ newIORef 0
1228− t <- liftIO $ getTime Monotonic
1229− lat <- liftIO $ newIORef (0, t)
1230− return $ WorkerInfo
1231− { workerYieldMax = 0
1232− , workerYieldCount = cntRef
1233− , workerLatencyStart = lat
1234− }
1234+ -- This allocation matters when significant number of workers are being
1235+ -- sent. We allocate it only when needed. The overhead increases by 4x.
1236+ winfo <-
1237+ case yieldRateInfo sv of
1238+ Nothing -> return Nothing
1239+ Just _ -> liftIO $ do
1240+ cntRef <- newIORef 0
1241+ t <- getTime Monotonic
1242+ lat <- newIORef (0, t)
1243+ return $ Just $ WorkerInfo
1244+ { workerYieldMax = 0
1245+ , workerYieldCount = cntRef
1246+ , workerLatencyStart = lat
1247+ }
12351248
12361249 doFork (wloop winfo) (handleChildException sv) >>= modifyThread sv
1250+#else
1251+ doFork (wloop Nothing) (handleChildException sv) >>= modifyThread sv
1252+#endif
12371253
12381254-- Returns:
12391255-- True: can dispatch more
@@ -1860,7 +1876,7 @@ getAheadSVar :: MonadAsync m
18601876 -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Int)
18611877 -> State t m a
18621878 -> SVar t m a
1863− -> WorkerInfo
1879+ -> Maybe WorkerInfo
18641880 -> m ())
18651881 -> IO (SVar t m a)
18661882getAheadSVar st f = do
@@ -2050,7 +2066,7 @@ newAheadVar :: MonadAsync m
20502066 -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Int)
20512067 -> State t m a
20522068 -> SVar t m a
2053− -> WorkerInfo
2069+ -> Maybe WorkerInfo
20542070 -> m ())
20552071 -> m (SVar t m a)
20562072newAheadVar st m wloop = do