Race-condition in alternative 'System.Timeout.timeout' implementation
tkn.akio at gmail.com
Wed Feb 27 13:03:12 CET 2013
Thank you for the explanation. My previous attempt obviously suffers
from the race condition you mention.
However it still seems to be possible to implement a compromise, using
both the IO manager and a new thread, i.e. forking only when the
computation is being timed out. The following implementation is as
fast as Herbert's timeout2, at least in the benchmark where the
computation rarely times out.
- Takano Akio
-- | Alternative implementation of 'System.Timeout.timeout' using
-- 'GHC.Event.registerTimeout' AND a watchdog-thread.
timeout4 :: Int -> IO a -> IO (Maybe a)
timeout4 to f
| to < 0 = fmap Just f
| to == 0 = return Nothing
| otherwise = do
mainTid <- myThreadId
ex <- fmap Timeout2 newUnique
Just em <- E.getSystemEventManager -- FIXME
killingThreadVar <- newEmptyMVar
let timeoutHandler = (>>return ()) $ forkIO $ do
killingTid <- myThreadId
success <- tryPutMVar killingThreadVar killingTid
when success $ throwTo mainTid ex
cleanupTimeout key = uninterruptibleMask_ $ do
-- Once the thread is in this uninterruptible block,
-- it never receives the exception 'ex' because:
-- (1) when we are in the uninterruptible block,
-- all attept of throwTo to kill this thread
-- will block.
-- (2) the killing thread will either fail to fill
-- 'killingThreadVar' or get killed before
-- this thread exits the block.
success <- tryPutMVar killingThreadVar undefined
when (not success) $ do
killingTid <- takeMVar killingThreadVar -- never blocks
E.unregisterTimeout em key
handleJust (\e -> if e == ex then Just () else Nothing)
(\_ -> return Nothing)
(bracket (E.registerTimeout em to timeoutHandler)
(\_ -> fmap Just f))
-------------- next part --------------
A non-text attachment was scrubbed...
Size: 4096 bytes
Desc: not available
More information about the Glasgow-haskell-users