Faster timeout but is it correct?

older
System.Mem.Weak semantics question

Bas van Dijk

16 Feb 2011 16 Feb '11

3:39 a.m.

Dear all, I wrote a faster implementation for System.Timeout.timeout but wonder whether it's correct. It would be great if someone can review the code. The implementation comes with a tiny Criterion benchmark: darcs get http://bifunctor.homelinux.net/~bas/bench_timeouts/ On ghc-7.0.1 with -O2 the following benchmark, which always times out, doesn't show a difference with the current timeout: timeout 1 (threadDelay 1000000) However the following benchmark, which never times out, shows nice speedups for both a non-threaded and a threaded version: timeout 1000000 (return ()) non-threaded: 3.6 faster threaded: 10.8 faster I suspect the reason why my timeout is faster is that I use only one 'catch' while the original uses two: handleJust and bracket. I have to admit that my implementation is more complex and more fragile than the original. That's why I'm not sure of it's correctness yet: newtype Timeout = Timeout Unique deriving (Eq, Typeable) instance Show Timeout where show _ = "<<timeout>>" instance Exception Timeout timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid <- myThreadId timeoutEx <- fmap Timeout newUnique uninterruptibleMask $ \restore -> do tid <- restore $ forkIO $ threadDelay n >> throwTo myTid timeoutEx let handle e = case fromException (e :: SomeException) of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> killThread tid >> throwIO e mb <- restore (fmap Just f) `catch` handle killThread tid return mb If nobody proves it incorrect I will make a patch for the base library. Regards, Bas

Show replies by date

Bas van Dijk

16 Feb 16 Feb

7:02 a.m.

I just submitted a patch for base: http://hackage.haskell.org/trac/ghc/ticket/4963 Regards, Bas

Bas van Dijk

9:03 a.m.

I made a slight modification and now it runs 16 times faster than the original: timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid <- myThreadId timeoutEx <- fmap Timeout newUnique uninterruptibleMask $ \restore -> do tid <- restore $ forkIO $ threadDelay n >> throwTo myTid timeoutEx (restore (fmap Just f) >>= \mb -> killThread tid >> return mb) `catch` \e -> case fromException e of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> killThread tid >> throwIO e However I may have noticed a deadlock in the previous version (maybe this version has it also). The deadlock occurred when running the externalException benchmark: externalException = do (tid, wait) <- fork $ timeout oneSec (threadDelay oneSec) threadDelay 500 throwTo tid MyException r <- wait case r of Left e | Just MyException <- fromException e -> return () _ -> error "MyException should have been thrown!" data MyException = MyException deriving (Show, Typeable) instance Exception MyException -- Fork a thread and return a computation that waits for its result. -- Equivalent to forkIO from the threads package. fork :: IO a -> IO (ThreadId, IO (Either SomeException a)) fork a = do res <- newEmptyMVar tid <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res return (tid, readMVar res) So please review this carefully. Bas

Bas van Dijk

2:26 p.m.

I realized that the previous timeout had problems when called in a masked thread. What happens is that the call to killThread will block because it can't throw the KillThread exception to the timeout thread because that thread is masked. I have to use unsafeUnmask to always unmask the timeout thread. Note that, for some reason, using forkIOUnmasked ... is much slower than using unsafeUnmask $ forkIO .... Any idea why? import GHC.IO (unsafeUnmask) imeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid <- myThreadId timeoutEx <- fmap Timeout newUnique uninterruptibleMask $ \restore -> do tid <- unsafeUnmask $ forkIO $ threadDelay n >> throwTo myTid timeoutEx (restore (fmap Just f) >>= \mb -> killThread tid >> return mb) `catch` \e -> case fromException e of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> killThread tid >> throwIO e For some reason this is slightly slower than the previous version which used restore instead of unsafeUnmask. However it's still 13 times faster than the original. The patch and benchmarks attached to the ticket are updated. Hopefully this is the last change I had to make so I can stop spamming. Regards, Bas

Bas van Dijk

6:27 p.m.

On 16 February 2011 20:26, Bas van Dijk wrote:

...

The patch and benchmarks attached to the ticket are updated. Hopefully this is the last change I had to make so I can stop spamming.

And the spamming continues... I started working on a hopefully even more efficient timeout that uses the new GHC event manager. The idea is that instead of forking a thread which delays for the timeout period after which it throws a Timeout exception, I register a timeout with the event manager. When the timeout fires the event manager will throw the Timeout exception. I haven't gotten around testing and benchmarking this yet. I hope to do that tomorrow evening. The code is currently living in the System.Event.Thread module: module System.Event.Thread where ... import Data.Typeable import Text.Show (Show, show) import GHC.Conc.Sync (myThreadId, throwTo) import GHC.IO (throwIO,unsafePerformIO ) import GHC.Exception (Exception, fromException) import Control.Exception.Base (catch) -- I'm currently using the Unique from System.Event -- because I got a circular import error when using Data.Unique: import System.Event.Unique (UniqueSource, newSource, Unique, newUnique) uniqSource :: UniqueSource uniqSource = unsafePerformIO newSource {-# NOINLINE uniqSource #-} newtype Timeout = Timeout Unique deriving Eq INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout") instance Show Timeout where show _ = "<<timeout>>" instance Exception Timeout timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId uniq <- newUnique uniqSource let timeoutEx = Timeout uniq Just mgr <- readIORef eventManager mask $ \restore -> do reg <- registerTimeout mgr usecs (throwTo myTid timeoutEx) let unregTimeout = M.unregisterTimeout mgr reg (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> unregTimeout >> throwIO e Regards, Bas

Felipe Almeida Lessa

6:46 p.m.

On Wed, Feb 16, 2011 at 9:27 PM, Bas van Dijk wrote:

...

I started working on a hopefully even more efficient timeout that uses the new GHC event manager.

The idea is that instead of forking a thread which delays for the timeout period after which it throws a Timeout exception, I register a timeout with the event manager. When the timeout fires the event manager will throw the Timeout exception.

Doesn't this version need unsafeUnmask? Cheers! -- Felipe.

Bas van Dijk

6:58 p.m.

On 17 February 2011 00:46, Felipe Almeida Lessa wrote:

...

On Wed, Feb 16, 2011 at 9:27 PM, Bas van Dijk wrote:

...
I started working on a hopefully even more efficient timeout that uses the new GHC event manager.

The idea is that instead of forking a thread which delays for the timeout period after which it throws a Timeout exception, I register a timeout with the event manager. When the timeout fires the event manager will throw the Timeout exception.

Doesn't this version need unsafeUnmask?

The unsafeUnmask was needed to ensure that throwing a ThreadKilled exception to the timeout thread won't block. Since this version doesn't have a timeout thread anymore we don't need the unsafeUnmask. Bas

Simon Marlow

17 Feb 17 Feb

7:13 a.m.

On 16/02/2011 23:27, Bas van Dijk wrote:

...

On 16 February 2011 20:26, Bas van Dijk wrote:

...
The patch and benchmarks attached to the ticket are updated. Hopefully this is the last change I had to make so I can stop spamming.

And the spamming continues...

I started working on a hopefully even more efficient timeout that uses the new GHC event manager.

The idea is that instead of forking a thread which delays for the timeout period after which it throws a Timeout exception, I register a timeout with the event manager. When the timeout fires the event manager will throw the Timeout exception.

I haven't gotten around testing and benchmarking this yet. I hope to do that tomorrow evening.

The code is currently living in the System.Event.Thread module:

module System.Event.Thread where ... import Data.Typeable import Text.Show (Show, show) import GHC.Conc.Sync (myThreadId, throwTo) import GHC.IO (throwIO,unsafePerformIO ) import GHC.Exception (Exception, fromException) import Control.Exception.Base (catch)

-- I'm currently using the Unique from System.Event -- because I got a circular import error when using Data.Unique: import System.Event.Unique (UniqueSource, newSource, Unique, newUnique)

uniqSource :: UniqueSource uniqSource = unsafePerformIO newSource {-# NOINLINE uniqSource #-}

newtype Timeout = Timeout Unique deriving Eq INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout")

instance Show Timeout where show _ = "<<timeout>>"

instance Exception Timeout

timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs< 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid<- myThreadId uniq<- newUnique uniqSource let timeoutEx = Timeout uniq Just mgr<- readIORef eventManager mask $ \restore -> do reg<- registerTimeout mgr usecs (throwTo myTid timeoutEx) let unregTimeout = M.unregisterTimeout mgr reg (restore (fmap Just f)>>= \mb -> unregTimeout>> return mb) `catch` \e -> case fromException e of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> unregTimeout>> throwIO e

If this version works, it's definitely preferable to your first proposal. It relies on unregisterTimeout not being interruptible - otherwise you're back to uninterruptibleMask again. Cheers, Simon

Simon Marlow

7:09 a.m.

On 16/02/2011 08:39, Bas van Dijk wrote:

...

timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n< 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid<- myThreadId timeoutEx<- fmap Timeout newUnique uninterruptibleMask $ \restore -> do tid<- restore $ forkIO $ threadDelay n>> throwTo myTid timeoutEx

let handle e = case fromException (e :: SomeException) of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> killThread tid>> throwIO e

mb<- restore (fmap Just f) `catch` handle killThread tid return mb

If nobody proves it incorrect I will make a patch for the base library.

uninterruptibleMask is quite unsavoury, I don't think we should use it here. I can see why you used it though: the killThread in the main thread will always win over the throwTo in the timeout thread, and that lets you avoid the outer exception handler. Hmm, it makes me uncomfortable, but I can't find any actual bugs. At the very least it needs some careful commentary to explain how it works. Cheers, Simon

Bas van Dijk

2:34 p.m.

On 17 February 2011 13:09, Simon Marlow wrote:

...

uninterruptibleMask is quite unsavoury,

Agreed, that's why I called this implementation "fragile" because it relies on the, not well known semantics, of interruptible operations.

...

I don't think we should use it here.

I agree that it looks fishy. However the biggest part of the computation passed to uninterruptibleMask is running in the restored state. The only part that is running in uninterruptible masked state that may potentially block (and thus potentially deadlock) is the killThread in the exception handler. However since the timeout thread is running inside unsafeUnmask it is ensured that the ThreadKilled exception always gets thrown.

...

I can see why you used it though: the killThread in the main thread will always win over the throwTo in the timeout thread, and that lets you avoid the outer exception handler.

Yes, and I think that the removal of the outer exception handler makes the code run so much faster.

...

Hmm, it makes me uncomfortable, but I can't find any actual bugs. At the very least it needs some careful commentary to explain how it works.

Good point, I will add a comment with an explanation how it works. My brother Roel had an interesting idea how to make the code run even faster by replacing the Unique with the ThreadId of the timeout thread. I implemented it and it now runs 19 times faster than the original compared to the 13 times faster of my previous version. Here's the new implementation: newtype Timeout = Timeout ThreadId deriving (Eq, Typeable) instance Show Timeout where show _ = "<<timeout>>" instance Exception Timeout timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid <- myThreadId uninterruptibleMask $ \restore -> do tid <- unsafeUnmask $ forkIO $ do tid <- myThreadId threadDelay n throwTo myTid $ Timeout tid (restore (fmap Just f) >>= \mb -> killThread tid >> return mb) `catch` \e -> case fromException e of Just (Timeout tid') | tid' == tid -> return Nothing _ -> killThread tid >> throwIO e It relies on ThreadIds being unique, but I believe this is the case because otherwise the throwTo operation will be nondeterministic, right? Obviously, this trick won't work in the event-manager-based version because I don't fork a thread there. So I have to keep using Uniques in that version. Speaking of Uniques: what is the best way to create them? I see 3 options: * Data.Unique. I tried using it but got a circular import error. Maybe I can get around that with a boot file. * System.Event.Unique. This is what I currently use. However I need to create a UniqSource for the newUnique function which may be a bit ugly: uniqSource :: UniqueSource uniqSource = unsafePerformIO newSource {-# NOINLINE uniqSource #-} * Also use System.Event.Unique but get the UniqSource from the EventManager. This does require that the emUniqueSource function is exported which it currently isnt't. Johan what do you think? import System.Event.Manager (emUniqueSource) timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId Just mgr <- readIORef eventManager uniq <- newUnique $ emUniqueSource mgr let timeoutEx = Timeout uniq mask $ \restore -> do reg <- registerTimeout mgr usecs (throwTo myTid timeoutEx) let unregTimeout = M.unregisterTimeout mgr reg (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing _ -> unregTimeout >> throwIO e Regards, Bas

Bas van Dijk

2:53 p.m.

On 17 February 2011 20:34, Bas van Dijk wrote:

...

Speaking of Uniques: what is the best way to create them? I see 3 options:

There may be a 4th option but it requires changing the System.Event.Manager.registerTimeout function from: registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey to: registerTimeout :: EventManager -> Int -> (TimeoutKey -> TimeoutCallback) -> IO TimeoutKey Then we can use the TimeoutKey as our Unique (Note that a TimeoutKey is actually a newtype for a Unique): newtype Timeout = Timeout TimeoutKey deriving Eq instance Exception Timeout timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId Just mgr <- readIORef eventManager mask $ \restore -> do reg <- registerTimeout mgr usecs $ \reg -> throwTo myTid $ Timeout reg let unregTimeout = M.unregisterTimeout mgr reg (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just (Timeout reg') | reg' == reg -> return Nothing _ -> unregTimeout >> throwIO e Bas

Bryan O'Sullivan

5:43 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk wrote:

...

Then we can use the TimeoutKey as our Unique (Note that a TimeoutKey is actually a newtype for a Unique):

That should be fine. It's not a public API, so changing it like that shouldn't be an issue.

Johan Tibell

6:56 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Thu, Feb 17, 2011 at 2:43 PM, Bryan O'Sullivan wrote:

...

On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk wrote:

...
Then we can use the TimeoutKey as our Unique (Note that a TimeoutKey is actually a newtype for a Unique):

That should be fine. It's not a public API, so changing it like that shouldn't be an issue.

I think this sounds like a good option.

Bas van Dijk

7:09 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 18 February 2011 00:56, Johan Tibell wrote:

...

On Thu, Feb 17, 2011 at 2:43 PM, Bryan O'Sullivan wrote:

...
On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk wrote:

...
Then we can use the TimeoutKey as our Unique (Note that a TimeoutKey is actually a newtype for a Unique):

That should be fine. It's not a public API, so changing it like that shouldn't be an issue.

I think this sounds like a good option.

Currently I created a new function registerTimeoutWithKey and wrote registerTimeout in terms of it. I also exported registerTimeoutWithKey from System.Event.Manager and System.Event. This isn't necessary so I can easily change it back. However maybe it's useful on its own. It does require a library proposal so I have to think it over. The changes are only minimal: ------------------------------------------------------------------------ -- Registering interest in timeout events -- | Register a timeout in the given number of microseconds. The -- returned 'TimeoutKey' can be used to later unregister or update the -- timeout. The timeout is automatically unregistered after the given -- time has passed. Note that: -- -- @registerTimeout mgr us cb = 'registerTimeoutWithKey' mgr us $ \_ -> cb@ registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr us cb = registerTimeoutWithKey mgr us $ \_ -> cb -- | Like 'registerTimeout' but the 'TimeoutCallback' is given the 'TimeoutKey'. registerTimeoutWithKey :: EventManager -> Int -> (TimeoutKey -> TimeoutCallback) -> IO TimeoutKey registerTimeoutWithKey mgr us f = do !key <- newUnique (emUniqueSource mgr) let tk = TK key cb = f tk if us <= 0 then cb else do now <- getCurrentTime let expTime = fromIntegral us / 1000000.0 + now -- We intentionally do not evaluate the modified map to WHNF here. -- Instead, we leave a thunk inside the IORef and defer its -- evaluation until mkTimeout in the event loop. This is a -- workaround for a nasty IORef contention problem that causes the -- thread-delay benchmark to take 20 seconds instead of 0.2. atomicModifyIORef (emTimeouts mgr) $ \f -> let f' = (Q.insert key expTime cb) . f in (f', ()) wakeManager mgr return tk The timeout function is now defined as: newtype Timeout = Timeout TimeoutKey instance Exception Timeout timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId Just mgr <- readIORef eventManager mask $ \restore -> do key <- registerTimeoutWithKey mgr usecs $ \key -> throwTo myTid $ Timeout key let unregTimeout = M.unregisterTimeout mgr key (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just (Timeout key') | key' == key -> return Nothing _ -> unregTimeout >> throwIO e Benchmarks are coming... Bas

Johan Tibell

7:16 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Thu, Feb 17, 2011 at 4:09 PM, Bas van Dijk wrote:

...

Currently I created a new function registerTimeoutWithKey and wrote registerTimeout in terms of it. I also exported registerTimeoutWithKey from System.Event.Manager and System.Event. This isn't necessary so I can easily change it back. However maybe it's useful on its own.

I say only export a more general function (under the old name).

...

It does require a library proposal so I have to think it over.

It doesn't. System.Event isn't a public API. Doesn't mean that you don't have to think it over thought. ;) Johan

Bas van Dijk

7:19 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 18 February 2011 01:16, Johan Tibell wrote:

...

On Thu, Feb 17, 2011 at 4:09 PM, Bas van Dijk wrote:

...
Currently I created a new function registerTimeoutWithKey and wrote registerTimeout in terms of it. I also exported registerTimeoutWithKey from System.Event.Manager and System.Event. This isn't necessary so I can easily change it back. However maybe it's useful on its own.

I say only export a more general function (under the old name).

Agreed.

...

...
It does require a library proposal so I have to think it over.

It doesn't. System.Event isn't a public API. Doesn't mean that you don't have to think it over thought. ;)

Why is it not public? It is listed in the base API docs: http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-Even... Bas

Johan Tibell

7:28 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Thu, Feb 17, 2011 at 4:19 PM, Bas van Dijk wrote:

...

Why is it not public? It is listed in the base API docs:

http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-Even...

Because it's not explicitly designed to be. Eventually it should be. We designed it as a separate library and didn't change the names when merging it into GHC (that was painful enough as it was). I did send a patch to add a comment to that affect to the GHC mailing list but perhaps it never got applied. Johan

Bas van Dijk

7:31 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 18 February 2011 01:28, Johan Tibell wrote:

...

On Thu, Feb 17, 2011 at 4:19 PM, Bas van Dijk wrote:

...
Why is it not public? It is listed in the base API docs:

http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-Even...

Because it's not explicitly designed to be.

Ok, that will make changing it a bit easier. Thanks, Bas

Bas van Dijk

8:01 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 18 February 2011 01:09, Bas van Dijk wrote:

...

Benchmarks are coming...

Here are some preliminary benchmarks. I used the latest GHC HEAD (7.1.20110217) build for performance. Because I wanted to finish the build of ghc before I went to bed I used a faster machine than my laptop. So the results should not be compared to my previous results. PC specs: CPU: Intel Core 2 Duo 3Ghz. with 6MB cache OS: An up to date 64bit Ubuntu 10.10 First of all the implementations: The current: data Timeout = Timeout Unique timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do pid <- myThreadId ex <- fmap Timeout newUnique handleJust (\e -> if e == ex then Just () else Nothing) (\_ -> return Nothing) (bracket (forkIO (threadDelay n >> throwTo pid ex)) (killThread) (\_ -> fmap Just f)) The new: newtype Timeout = Timeout ThreadId timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid <- myThreadId uninterruptibleMask $ \restore -> do tid <- unsafeUnmask $ forkIO $ do tid <- myThreadId threadDelay n throwTo myTid $ Timeout tid (restore (fmap Just f) >>= \mb -> killThread tid >> return mb) `catch` \e -> case fromException e of Just (Timeout tid') | tid' == tid -> return Nothing _ -> killThread tid >> throwIO e The event-manager based: newtype Timeout = Timeout TimeoutKey timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId Just mgr <- readIORef eventManager mask $ \restore -> do key <- registerTimeoutWithKey mgr usecs $ \key -> throwTo myTid $ Timeout key let unregTimeout = M.unregisterTimeout mgr key (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just (Timeout key') | key' == key -> return Nothing _ -> unregTimeout >> throwIO e The benchmarks: (These should really be extended!) willTimeout = shouldTimeout $ timeout 1 (threadDelay oneSec) wontTimeout = shouldNotTimeout $ timeout oneSec (return ()) nestedTimeouts = shouldTimeout $ timeout 100000 $ shouldNotTimeout $ timeout (2*oneSec) $ threadDelay oneSec externalException = do (tid, wait) <- fork $ timeout oneSec (threadDelay oneSec) threadDelay 500 throwTo tid MyException r <- wait case r of Left e | Just MyException <- fromException e -> return () _ -> error "MyException should have been thrown!" Results: The benchmarks were build with -O2 and -threaded and run without RTS options (So no -N2, I may do that later but AFAIK the RTS will automatically find the number of cores) willTimeout/old 24.34945 us 1.0 x willTimeout/new 26.91964 us 0.9 x (large std dev: 5 us) willTimeout/event 12.94273 us 1.9 x :-) wontTimeout/old 16.25766 us 1.0 x wontTimeout/new 637.8685 ns 25.5 x :-) wontTimeout/event 1.565311 us 10.4 x :-) externalException/old 10.28582 ms 1.0 x externalException/new 9.960918 ms 1.0 x externalException/event 10.25484 ms 1.0 x nestedTimeouts/old 108.1759 ms 1.0 x nestedTimeouts/new 108.4585 ms 1.0 x nestedTimeouts/event 109.9614 ms 1.0 x Preliminary conclusions: I think the most important benchmark is wontTimeout because AFAIK that's the most common situation. As can be seen, the new implementation is 25 times faster than the old one. The event-manager based implementation is 10 times faster than the old one but not quite as fast as the new one. Although the event-manager based timeout has to do less work the new one probably exploits parallelism because it forks a thread to do part of its work. A nice result is that in my previous efforts I couldn't achieve speedups in the willTimeout benchmark. Fortunately the event-manager based implementation is twice as fast as the original. Further work: I will brainstorm on this some more and update my patches for base during the weekend. Regards, Bas

Johan Tibell

8:05 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Thu, Feb 17, 2011 at 5:01 PM, Bas van Dijk wrote:

...

willTimeout/old 24.34945 us 1.0 x willTimeout/new 26.91964 us 0.9 x (large std dev: 5 us) willTimeout/event 12.94273 us 1.9 x :-)

wontTimeout/old 16.25766 us 1.0 x wontTimeout/new 637.8685 ns 25.5 x :-) wontTimeout/event 1.565311 us 10.4 x :-)

I find this very surprising. Both new and event eventually ends up using the event manager in the end. One via threadDelay (which calls registerTimeout) and one directly via registerTimeout. The difference should be that "new" also spawns a thread. Johan

Bas van Dijk

18 Feb 18 Feb

4:14 a.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 18 February 2011 01:05, Johan Tibell wrote:

...

On Thu, Feb 17, 2011 at 5:01 PM, Bas van Dijk wrote:

...
willTimeout/old 24.34945 us 1.0 x willTimeout/new 26.91964 us 0.9 x (large std dev: 5 us) willTimeout/event 12.94273 us 1.9 x :-)

wontTimeout/old 16.25766 us 1.0 x wontTimeout/new 637.8685 ns 25.5 x :-) wontTimeout/event 1.565311 us 10.4 x :-)

I find this very surprising. Both new and event eventually ends up using the event manager in the end. One via threadDelay (which calls registerTimeout) and one directly via registerTimeout. The difference should be that "new" also spawns a thread.

I guess the new timeout exploits parallelism because it forks a thread do to the work with the event manager. I think that this thread is then killed before it even begins dealing (through threadDelay) with the event manager. Bas

Bas van Dijk

6:04 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

I have some more results: The willTimeout and wontTimeout benchmarks are a bit unfair: willTimeout = shouldTimeout $ timeout 1 (threadDelay oneSec) wontTimeout = shouldNotTimeout $ timeout oneSec (return ()) Nobody ever writes code like this. So I wrote some benchmarks that hopefully better reflect some real-world code: busyWillTimeout = do r <- newIORef 10000000 shouldTimeout $ timeout 100 $ busy r n <- readIORef r when (n==0) $ error "n == 0 !!!" busyWontTimeout = do r <- newIORef 1000 shouldNotTimeout $ timeout oneSec $ busy r n <- readIORef r when (n/=0) $ error "n /= 0 !!!" busy r = do n <- readIORef r if n == 0 then return () else writeIORef r (n - 1) >> busy r shouldTimeout :: IO (Maybe a) -> IO () shouldTimeout m = do mb <- m case mb of Nothing -> return () _ -> error "Should have timed out!" shouldNotTimeout :: IO (Maybe a) -> IO a shouldNotTimeout m = do mb <- m case mb of Just x -> return x _ -> error "Should not have timed out!" The busyWontTimeout is the most representative benchmark. It performs a busy computation and gives it enough time to complete. This time I ren the benchmarks with +RTS -N2: willTimeout/old 22.78159 us 1.0 x willTimeout/new 22.34967 us 1.0 x willTimeout/event 10.05289 us 2.3 x busyWillTimeout/old 10.58061 ms 1.0 x (std dev: 4.6) busyWillTimeout/new 11.89530 ms 0.9 x (std dev: 4.6) busyWillTimeout/event 9.983601 ms 1.1 x (std dev: 1.2) wontTimeout/old 13.78843 us 1.0 x wontTimeout/new 832.4918 ns 16.6 x wontTimeout/event 1.042921 us 13.2 x busyWontTimeout/old 57.10021 us 1.0 x busyWontTimeout/new 56.85652 us 1.0 x busyWontTimeout/event 35.67142 us 1.6 x The willTimeout benchmark is slightly faster with -N2 while the wontTimeout is slightly slower. All timeouts score similarly in the busyWillTimeout benchmark. The most representative busyWontTimeout benchmark is the interesting one. Both the old and new score similarly while the event-manager based timeout is a modest 1.6 x faster. Since this is the most representative benchmark I'm beginning to favour this implementation. While writing this email I was doing another run of the benchmarks. Suddenly the willTimeout/new benchmark crashed with the message: benchmarking willTimeout/new collecting 100 samples, 211 iterations each, in estimated 654.8272 ms bench_timeouts_threaded: <<timeout>> Oops! That "<<timeout>>" is the Timeout exception not getting caught by my exception handler while it should. This is a major bug. I believe it is caused by this piece of code: ... uninterruptibleMask $ \restore -> do tid <- unsafeUnmask $ forkIO $ do tid <- myThreadId threadDelay n throwTo myTid $ Timeout tid ... While I uninterruptibly mask asynchronous exceptions I need to temporarily unmask them so that the forked thread can be killed lateron. I think the bug is that I first call unsafeUnmask and then fork the thread which throws the Timeout exception. I can imagine there's a brief period after the forkIO call where we're still in the unmasked state. If the timeout thread then immediately throws the Timeout exception (which is the case in the willTimeout benchmark) it will be received by our thread and won't get caught. The solution is probably to reverse the order of: "unsafeUnmask $ forkIO" to "forkIO $ unsafeUnmask". Or just use "forkIOUnmasked". The reason I didn't used that in the first place was that it was much slower for some reason. So, since the new implementation is not really faster in a representative benchmark and above all is buggy, I'm planning to ditch it in favour of the event-manager based timeout. Thanks for reading my rambling, Bas

Felipe Almeida Lessa

6:21 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Fri, Feb 18, 2011 at 9:04 PM, Bas van Dijk wrote:

...

The most representative busyWontTimeout benchmark is the interesting one. Both the old and new score similarly while the event-manager based timeout is a modest 1.6 x faster. Since this is the most representative benchmark I'm beginning to favour this implementation.

That's nice, as it is also simpler than 'new'.

...

Thanks for reading my rambling,

Analysis of our core libraries are always great! Thanks, -- Felipe.

Bas van Dijk

21 Feb 21 Feb

3:39 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 19 February 2011 00:04, Bas van Dijk wrote:

...

So, since the new implementation is not really faster in a representative benchmark and above all is buggy, I'm planning to ditch it in favour of the event-manager based timeout.

The patch is ready for review: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp... Bas

Johan Tibell

3:55 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Mon, Feb 21, 2011 at 12:39 PM, Bas van Dijk wrote:

...

On 19 February 2011 00:04, Bas van Dijk wrote:

...
So, since the new implementation is not really faster in a representative benchmark and above all is buggy, I'm planning to ditch it in favour of the event-manager based timeout.

The patch is ready for review:

http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

Instead of defining registerTimeout :: EventManager -> Int -> (TimeoutKey -> TimeoutCallback) -> IO TimeoutKey include TimeoutKey in the TimeoutCallback type. Someone who better understands the exception masking parts could give you better feedback on that code. Johan

Bas van Dijk

6:16 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 21 February 2011 21:55, Johan Tibell wrote:

...

...include TimeoutKey in the TimeoutCallback type.

Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp... Thanks, Bas

Johan Tibell

10:10 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk wrote:

...

On 21 February 2011 21:55, Johan Tibell wrote:

...
...include TimeoutKey in the TimeoutCallback type.

Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

Could we store a full TimeoutCallback in the PSQ? At the line that reads sequence_ $ map Q.value expired you'll need to pass the PSQ key (which is the Unique) to the callback. Most callbacks will ignore this key but by doing this we 1) decrease the size of the closure we store in the PSQ and 2) make the mechanism more flexible for future use. (There's a small chance that I've read the diff wrong. I haven't applied the patch and look at it in a real diff viewer). Johan

Bas van Dijk

22 Feb 22 Feb

5:46 a.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 22 February 2011 03:10, Johan Tibell wrote:

...

On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk wrote:

...
On 21 February 2011 21:55, Johan Tibell wrote:

...
...include TimeoutKey in the TimeoutCallback type.

Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

Could we store a full TimeoutCallback in the PSQ? At the line that reads

sequence_ $ map Q.value expired

you'll need to pass the PSQ key (which is the Unique) to the callback.

Good point. Something like this: sequence_ $ map (\(Elem key _ cb) -> cb (TK key)) expired

...

Most callbacks will ignore this key but by doing this we 1) decrease the size of the closure we store in the PSQ and 2) make the mechanism more flexible for future use.

Ok, I will apply it this evening. Bas

Johan Tibell

11:06 a.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On Tue, Feb 22, 2011 at 2:46 AM, Bas van Dijk wrote:

...

On 22 February 2011 03:10, Johan Tibell wrote:

...
On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk wrote:

...
On 21 February 2011 21:55, Johan Tibell wrote:

...
...include TimeoutKey in the TimeoutCallback type.

Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

Could we store a full TimeoutCallback in the PSQ? At the line that reads

sequence_ $ map Q.value expired

you'll need to pass the PSQ key (which is the Unique) to the callback.

Good point. Something like this:

sequence_ $ map (\(Elem key _ cb) -> cb (TK key)) expired

Yes.

...

Ok, I will apply it this evening.

Excellent. Thanks for working on this. Johan

Bas van Dijk

1:45 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 22 February 2011 17:06, Johan Tibell wrote:

...

On Tue, Feb 22, 2011 at 2:46 AM, Bas van Dijk wrote:

...
Ok, I will apply it this evening.

Excellent. Thanks for working on this.

Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

Bertram Felgenhauer

1:59 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

Bas van Dijk wrote:

...

On 19 February 2011 00:04, Bas van Dijk wrote:

...
So, since the new implementation is not really faster in a representative benchmark and above all is buggy, I'm planning to ditch it in favour of the event-manager based timeout.

The patch is ready for review:

http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

(For reference, this is the proposed timeout code:) | timeout :: Int -> IO a -> IO (Maybe a) | timeout usecs f | | usecs < 0 = fmap Just f | | usecs == 0 = return Nothing | | otherwise = do | myTid <- myThreadId | Just mgr <- readIORef eventManager | mask $ \restore -> do | key <- registerTimeout mgr usecs $ \key -> | throwTo myTid $ Timeout key | let unregTimeout = M.unregisterTimeout mgr key | (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) | `catch` \e -> | case fromException e of | Just (Timeout key') | key' == key -> return Nothing | _ -> unregTimeout >> throwIO e What happens if the timeout triggers while the exception handler is running? I.e., we have the following sequence of events: 1. registerTimeout 2. (fmap Just f) raises an exception, or the thread gets killed otherwise. 3. We enter the `catch` handler, with the corresponding exception. 4. The timeout expires, and the event Manager runs the IO action, i.e. throwTo myTid $ Timeout key 5. And now we have a pending Timeout exception which escapes the 'timeout'. The unregTimeout will come too late. The current implementation avoids this problem, by handling the Timeout exception in a context where the forked timeout thread has either done its job or is no longer running. I suspect the event manager implementation needs to do the same. Furthermore, in place of the killThread we need to find a different function that guarantees that the timeout action can no longer be run. (Look at the event manager and consider what happens if 'step' and 'unregisterTimeout' from the event manager run concurrently.) I've stumbled on another problem with the timeout function. Is this already known? Namely, the current implementation has trouble protecting against asynchronous exceptions, which can cause Timeout exceptions to escape from the corresponding 'timeout' call. The following program demonstrates this issue. (tested on ghc 7.0.1 using the threaded runtime) {-# LANGUAGE ScopedTypeVariables #-} import System.Timeout import Control.Exception import Control.Concurrent import Control.Monad import Prelude hiding (catch) delay = threadDelay 1000 test = do let act = timeout 1 (threadDelay 1) >> delay act' = (act `catch` \ThreadKilled -> return ()) >> delay tid <- forkIO $ act' `catch` \(e :: SomeException) -> putStr $ "gotcha: " ++ show e ++ "!\n" forkIO $ (threadDelay 10) >> killThread tid return () main = do replicateM_ 1000 test threadDelay 100000 (Will print gotcha: <<timeout>>! for every escaping Timout exception.) What I believe happens is that the 'killThread' in the timeout function is interrupted by the 'killThread' from the test program; as a result, the forked timeout thread continues to run after the timeout function itself has finished. Protecting against this seems hard, if not impossible. Even if we introduce a lock lock <- newMVar () and let the timeout thread take the lock before throwing the exception ... forkIO (threadDelay n >> takeMVar lock >> throwTo pid ex) ... when handling the exception we still face a problem: We can use tryTakeMVar lock to stop the timeout thread from killing us, and to detect whether it's already too late for that. However, in that latter case, we will have to wait for the Timeout exception to arrive, in order to filter it; that means we will have to catch and remember all other pending async exception first, filter the Timeout exception, and then re-raise all the exceptions again. I suspect that the event manager based implementation will face the same problem. Tricky, and I guess guaranteeing that the Timeout exception does not escape in the preseence of other async exceptions is too much to ask. Bertram

Bas van Dijk

5:50 p.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 22 February 2011 19:59, Bertram Felgenhauer wrote:

...

Bas van Dijk wrote:

...
On 19 February 2011 00:04, Bas van Dijk wrote:

...
So, since the new implementation is not really faster in a representative benchmark and above all is buggy, I'm planning to ditch it in favour of the event-manager based timeout.

The patch is ready for review:

http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dp...

(For reference, this is the proposed timeout code:)

| timeout :: Int -> IO a -> IO (Maybe a) | timeout usecs f | | usecs < 0 = fmap Just f | | usecs == 0 = return Nothing | | otherwise = do | myTid <- myThreadId | Just mgr <- readIORef eventManager | mask $ \restore -> do | key <- registerTimeout mgr usecs $ \key -> | throwTo myTid $ Timeout key | let unregTimeout = M.unregisterTimeout mgr key | (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) | `catch` \e -> | case fromException e of | Just (Timeout key') | key' == key -> return Nothing | _ -> unregTimeout >> throwIO e

What happens if the timeout triggers while the exception handler is running? I.e., we have the following sequence of events:

1. registerTimeout 2. (fmap Just f) raises an exception, or the thread gets killed otherwise. 3. We enter the `catch` handler, with the corresponding exception. 4. The timeout expires, and the event Manager runs the IO action, i.e. throwTo myTid $ Timeout key 5. And now we have a pending Timeout exception which escapes the 'timeout'. The unregTimeout will come too late.

Bummer! You're right. But maybe we can catch and ignore a potential pending Timeout exception: (code not tested and profiled yet) timeout :: Int -> IO a -> IO (Maybe a) timeout usecs f | usecs < 0 = fmap Just f | usecs == 0 = return Nothing | otherwise = do myTid <- myThreadId Just mgr <- readIORef eventManager mask $ \restore -> do key <- registerTimeout mgr usecs $ \key -> throwTo myTid $ Timeout key let unregTimeout = M.unregisterTimeout mgr key (restore (fmap Just f) >>= \mb -> unregTimeout >> return mb) `catch` \e -> case fromException e of Just (Timeout key') | key' == key -> return Nothing _ -> do (unregTimeout >> allowInterrupt) `catch` \(Timeout _) -> return () throwIO e Note I use the newly proposed[1] allowInterrupt: -- | When invoked inside 'mask', this function allows a blocked -- asynchronous exception to be raised, if one exists. It is -- equivalent to performing an interruptible operation (see -- #interruptible#), but does not involve any actual blocking. -- -- When called outside 'mask', or inside 'uninterruptibleMask', this -- function has no effect. allowInterrupt :: IO () allowInterrupt = unsafeUnmask $ return ()

...

I've stumbled on another problem with the timeout function. Is this already known? Namely, the current implementation has trouble protecting against asynchronous exceptions, which can cause Timeout exceptions to escape from the corresponding 'timeout' call. The following program demonstrates this issue. (tested on ghc 7.0.1 using the threaded runtime)

{-# LANGUAGE ScopedTypeVariables #-} import System.Timeout import Control.Exception import Control.Concurrent import Control.Monad import Prelude hiding (catch)

delay = threadDelay 1000

test = do let act = timeout 1 (threadDelay 1) >> delay act' = (act `catch` \ThreadKilled -> return ()) >> delay tid <- forkIO $ act' `catch` \(e :: SomeException) -> putStr $ "gotcha: " ++ show e ++ "!\n" forkIO $ (threadDelay 10) >> killThread tid return ()

main = do replicateM_ 1000 test threadDelay 100000

(Will print gotcha: <<timeout>>! for every escaping Timout exception.) What I believe happens is that the 'killThread' in the timeout function is interrupted by the 'killThread' from the test program; as a result, the forked timeout thread continues to run after the timeout function itself has finished.

Protecting against this seems hard, if not impossible. Even if we introduce a lock lock <- newMVar () and let the timeout thread take the lock before throwing the exception ... forkIO (threadDelay n >> takeMVar lock >> throwTo pid ex) ... when handling the exception we still face a problem: We can use tryTakeMVar lock to stop the timeout thread from killing us, and to detect whether it's already too late for that. However, in that latter case, we will have to wait for the Timeout exception to arrive, in order to filter it; that means we will have to catch and remember all other pending async exception first, filter the Timeout exception, and then re-raise all the exceptions again.

I suspect that the event manager based implementation will face the same problem.

Actually the event manager based implementation totally crashes on your example, so again: bummer! I get the following error: "gotcha: user error (Pattern match failure in do expression at libraries/base/System/Event/Thread.hs:208:9-16)!" Line 208: Just mgr <- readIORef eventManager I assumed that pattern match was safe because it's also used like that in other places in the event manager (threadDelay, registerDelay, closeFdWith and threadWait). I guess I was wrong... All in all I have to seriously study this some more. Thanks, Bas [1] http://hackage.haskell.org/trac/ghc/ticket/4857

Bertram Felgenhauer

23 Feb 23 Feb

4:59 a.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

...

...
1. registerTimeout 2. (fmap Just f) raises an exception, or the thread gets killed otherwise. 3. We enter the `catch` handler, with the corresponding exception. 4. The timeout expires, and the event Manager runs the IO action, i.e. throwTo myTid $ Timeout key 5. And now we have a pending Timeout exception which escapes the 'timeout'. The unregTimeout will come too late.

Bummer! You're right.

But maybe we can catch and ignore a potential pending Timeout exception: (code not tested and profiled yet)

The trouble is that the throwTo action, even though we can no longer stop it using unregisterTimeout, may be delayed arbitrarily. So we'd have to wait for it to arrive. In that regard we have actually lost power compared to spawning a separate thread: throwTo (and thus killThread) explicitely guarantees that if two threads throw exceptions at one another simultaneously, only one of those will arrive, and also that if throwTo returns, the exception has actually been delivered. So if the killThread succeeds, the Timeout exception will never arrive.

...

Actually the event manager based implementation totally crashes on your example, so again: bummer! I get the following error:

"gotcha: user error (Pattern match failure in do expression at libraries/base/System/Event/Thread.hs:208:9-16)!"

Line 208:

Just mgr <- readIORef eventManager

Yikes! I don't believe that's supposed to happen, but I have no clue how the event manager is initially started - does the RTS invoke ensureIOManagerIsRunning before running main? Best regards, Bertram

Bas van Dijk

6:39 a.m.

New subject: [Haskell-cafe] Faster timeout but is it correct?

On 23 February 2011 10:59, Bertram Felgenhauer wrote:

...

...
...
1. registerTimeout 2. (fmap Just f) raises an exception, or the thread gets killed otherwise. 3. We enter the `catch` handler, with the corresponding exception. 4. The timeout expires, and the event Manager runs the IO action, i.e. throwTo myTid $ Timeout key 5. And now we have a pending Timeout exception which escapes the 'timeout'. The unregTimeout will come too late.

Bummer! You're right.

But maybe we can catch and ignore a potential pending Timeout exception: (code not tested and profiled yet)

The trouble is that the throwTo action, even though we can no longer stop it using unregisterTimeout, may be delayed arbitrarily. So we'd have to wait for it to arrive. In that regard we have actually lost power compared to spawning a separate thread: throwTo (and thus killThread) explicitely guarantees that if two threads throw exceptions at one another simultaneously, only one of those will arrive, and also that if throwTo returns, the exception has actually been delivered. So if the killThread succeeds, the Timeout exception will never arrive.

Unfortunately you're correct. One last attempt at solving this is to interrupt the throwTo action by throwing an exception to the thread that is executing the event handling loop: ... -> do unregTimeout throwTo emTid InterruptTimeout throwIO e where emTid is the ThreadId of the thread that is executing the event handling loop and InterruptTimeout is some custom exception. The event handling loop then has to ignore this exception when executing timeout callbacks: forM_ expired $ \(Q.E key _ cb) -> cb (TK key) `catch` \InterruptTimeout -> return () Of course the problem with this approach is that the InterruptTimeout will "crash" the event handling loop when it's thrown outside the scope of the above catch. It seems impossible to protect against that. Since this event manager based implementation is broken and since my earlier implementation was not actually faster on the more representative busyWontTimeout benchmark, I conclude that I can't improve on the current timeout. So I'm closing the ticket.

...

...
Actually the event manager based implementation totally crashes on your example, so again: bummer! I get the following error:

"gotcha: user error (Pattern match failure in do expression at libraries/base/System/Event/Thread.hs:208:9-16)!"

Line 208:

Just mgr <- readIORef eventManager

Yikes! I don't believe that's supposed to happen, but I have no clue how the event manager is initially started - does the RTS invoke ensureIOManagerIsRunning before running main?

It would be good to investigate the other uses of: Just mgr <- readIORef eventManager in System.Event.Thread to see if they have the same problem. Thanks, Bas

Simon Marlow

25 Mar 25 Mar

10:56 a.m.

On 17/02/2011 19:34, Bas van Dijk wrote:

...

On 17 February 2011 13:09, Simon Marlow wrote:

...
uninterruptibleMask is quite unsavoury,

Agreed, that's why I called this implementation "fragile" because it relies on the, not well known semantics, of interruptible operations.

...
I don't think we should use it here.

I agree that it looks fishy. However the biggest part of the computation passed to uninterruptibleMask is running in the restored state. The only part that is running in uninterruptible masked state that may potentially block (and thus potentially deadlock) is the killThread in the exception handler. However since the timeout thread is running inside unsafeUnmask it is ensured that the ThreadKilled exception always gets thrown.

...
I can see why you used it though: the killThread in the main thread will always win over the throwTo in the timeout thread, and that lets you avoid the outer exception handler.

Yes, and I think that the removal of the outer exception handler makes the code run so much faster.

...
Hmm, it makes me uncomfortable, but I can't find any actual bugs. At the very least it needs some careful commentary to explain how it works.

Good point, I will add a comment with an explanation how it works.

My brother Roel had an interesting idea how to make the code run even faster by replacing the Unique with the ThreadId of the timeout thread. I implemented it and it now runs 19 times faster than the original compared to the 13 times faster of my previous version. Here's the new implementation:

newtype Timeout = Timeout ThreadId deriving (Eq, Typeable)

instance Show Timeout where show _ = "<<timeout>>"

instance Exception Timeout

timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n< 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid<- myThreadId uninterruptibleMask $ \restore -> do tid<- unsafeUnmask $ forkIO $ do tid<- myThreadId threadDelay n throwTo myTid $ Timeout tid (restore (fmap Just f)>>= \mb -> killThread tid>> return mb) `catch` \e -> case fromException e of Just (Timeout tid') | tid' == tid -> return Nothing _ -> killThread tid>> throwIO e

It relies on ThreadIds being unique, but I believe this is the case because otherwise the throwTo operation will be nondeterministic, right?

(sorry for the late reply, just clearing my backlog) This won't work in the case of nested timeouts, unless I'm mistaken. Cheers, Simon

Bas van Dijk

4:01 p.m.

On 25 March 2011 15:56, Simon Marlow wrote:

...

On 17/02/2011 19:34, Bas van Dijk wrote:

...
On 17 February 2011 13:09, Simon Marlow wrote:

...
uninterruptibleMask is quite unsavoury,

Agreed, that's why I called this implementation "fragile" because it relies on the, not well known semantics, of interruptible operations.

...
I don't think we should use it here.

I agree that it looks fishy. However the biggest part of the computation passed to uninterruptibleMask is running in the restored state. The only part that is running in uninterruptible masked state that may potentially block (and thus potentially deadlock) is the killThread in the exception handler. However since the timeout thread is running inside unsafeUnmask it is ensured that the ThreadKilled exception always gets thrown.

...
I can see why you used it though: the killThread in the main thread will always win over the throwTo in the timeout thread, and that lets you avoid the outer exception handler.

Yes, and I think that the removal of the outer exception handler makes the code run so much faster.

...
Hmm, it makes me uncomfortable, but I can't find any actual bugs. At the very least it needs some careful commentary to explain how it works.

Good point, I will add a comment with an explanation how it works.

My brother Roel had an interesting idea how to make the code run even faster by replacing the Unique with the ThreadId of the timeout thread. I implemented it and it now runs 19 times faster than the original compared to the 13 times faster of my previous version. Here's the new implementation:

newtype Timeout = Timeout ThreadId deriving (Eq, Typeable)

instance Show Timeout where show _ = "<<timeout>>"

instance Exception Timeout

timeout :: Int -> IO a -> IO (Maybe a) timeout n f | n< 0 = fmap Just f | n == 0 = return Nothing | otherwise = do myTid<- myThreadId uninterruptibleMask $ \restore -> do tid<- unsafeUnmask $ forkIO $ do tid<- myThreadId threadDelay n throwTo myTid $ Timeout tid (restore (fmap Just f)>>= \mb -> killThread tid>> return mb) `catch` \e -> case fromException e of Just (Timeout tid') | tid' == tid -> return Nothing _ -> killThread tid>> throwIO e

It relies on ThreadIds being unique, but I believe this is the case because otherwise the throwTo operation will be nondeterministic, right?

(sorry for the late reply, just clearing my backlog)

This won't work in the case of nested timeouts, unless I'm mistaken.

Cheers, Simon

_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

Thanks for your reply Simon. In a previous email I already concluded that I can't improve on the existing timeout: "...Since this event manager based implementation is broken and since my earlier implementation was not actually faster on the more representative busyWontTimeout benchmark, I conclude that I can't improve on the current timeout. So I'm closing the ticket..." Regards, Bas

5170

Age (days ago)

5207

Last active (days ago)

List overview

Download

35 comments

6 participants

participants (6)

Bas van Dijk
Bertram Felgenhauer
Bryan O'Sullivan
Felipe Almeida Lessa
Johan Tibell
Simon Marlow