@@ -68,6 +68,12 @@ waitForOneChild chan pendingRef = do
68 tid <- liftIO $ atomically $ readTChan chan
68 tid <- liftIO $ atomically $ readTChan chan
69 liftIO $ modifyIORef pendingRef $ filter (\x -> threadId x /= tid)
69 liftIO $ modifyIORef pendingRef $ filter (\x -> threadId x /= tid)
71+-- | kill all the child threads associated with the continuation context
72+killChildren :: EventF -> IO ()
74+ ths <- readIORef (pendingThreads ctx)
75+ mapM_ (killThread . threadId) ths
71-- XXX this is not a real semaphore as it does not really block on wait,
77-- XXX this is not a real semaphore as it does not really block on wait,
72-- instead it returns whether the value is zero or non-zero.
78-- instead it returns whether the value is zero or non-zero.
@@ -120,8 +126,8 @@ forkIt current proc = do
121 updatePendingThreads :: MonadIO m => EventF -> EventF -> m ()
127 updatePendingThreads :: MonadIO m => EventF -> EventF -> m ()
122 updatePendingThreads cur child = do
128 updatePendingThreads cur child = do
123− -- update the new thread first so that if it exited already reclaim finds
129+ -- update the new thread first so that if it exited already reclaim
124− -- it in the list and does not panic.
130+ -- finds it in the list and does not panic.
125 liftIO $ modifyIORef (pendingThreads cur) $ (\ts -> child:ts)
131 liftIO $ modifyIORef (pendingThreads cur) $ (\ts -> child:ts)
126 tryReclaimZombies (zombieChannel cur) (pendingThreads cur)
132 tryReclaimZombies (zombieChannel cur) (pendingThreads cur)
@@ -142,9 +148,8 @@ forkIt current proc = do
143 beforeExit cur res = do
149 beforeExit cur res = do
144 case res of
150 case res of
145− Left _exc -> -- kill all child threads
151+ Left _exc -> liftIO $ killChildren cur
146 -- propagate the exception to the parent
152 -- propagate the exception to the parent
148 Right _ -> -- collect the results?
153 Right _ -> -- collect the results?
149 return ()
154 return ()
@@ -321,13 +326,6 @@ react setHandler iob = AsyncT $ do
321 put cont{event=Nothing}
326 put cont{event=Nothing}
322 return $ unsafeCoerce j
327 return $ unsafeCoerce j
324−-- Need to propagate the exception via kill exception handler
325−-- | kill all the child threads associated with the continuation context
326−killChildren :: IORef [EventF] -> IO ()
327−killChildren pendingRef = do
328− ths <- readIORef pendingRef
329− mapM_ (killThread . threadId) ths
331------------------------------------------------------------------------------
329------------------------------------------------------------------------------
332-- Controlling thread quota
330-- Controlling thread quota
333------------------------------------------------------------------------------
331------------------------------------------------------------------------------