Re: [Haskell-cafe] Faster timeout but is it correct?
On 22 February 2011 03:10, Johan Tibell johan.tib...@gmail.com wrote: On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk v.dijk@gmail.com wrote: On 21 February 2011 21:55, Johan Tibell johan.tib...@gmail.com wrote: ...include TimeoutKey in the TimeoutCallback type. Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dpatch 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Tue, Feb 22, 2011 at 2:46 AM, Bas van Dijk v.dijk@gmail.com wrote: On 22 February 2011 03:10, Johan Tibell johan.tib...@gmail.com wrote: On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk v.dijk@gmail.com wrote: On 21 February 2011 21:55, Johan Tibell johan.tib...@gmail.com wrote: ...include TimeoutKey in the TimeoutCallback type. Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dpatch 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 22 February 2011 17:06, Johan Tibell johan.tib...@gmail.com wrote: On Tue, Feb 22, 2011 at 2:46 AM, Bas van Dijk v.dijk@gmail.com 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.dpatch ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
Hi Bas, 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. The reason is probably that in order for the forkIOUnmaske-d thread to receive an exception (which it must, to be killed), it first has to be activated at least once, to perform the unsafeUnmask. So the worker thread's call to killThread will block. Now if there were a way to specify the exception mask of the newly created thread directly, it should be just as fast as the unsafeUnmask . forkIO version. I have not checked the event manager based implementation in detail, but from your numbers it looks like the best option at this time. Best regards, Bertram ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 19 February 2011 00:04, Bas van Dijk v.dijk@gmail.com 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.dpatch Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Mon, Feb 21, 2011 at 12:39 PM, Bas van Dijk v.dijk@gmail.com wrote: On 19 February 2011 00:04, Bas van Dijk v.dijk@gmail.com 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.dpatch 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
I'm curious, is it possible that your new timeout implementation would fix this problem?: doesntWork :: Int - Int doesntWork x = last $ cycle [x] test :: IO (Maybe Bool) test = timeout 1 $ evaluate $ doesntWork 5 == 5 -- never terminates, even with the timeout From what I can gather, this problem is caused by a lack of context switches in the code for 'doesntWork' so I doubt that a new implementation of timeout would fix it, but I thought I'd ask :) It's super annoying, especially when it happens when you're not expecting it. (btw, I've only tested the above code in ghc 6.x, so I have no idea if the behavior is the same in 7) - Job On Mon, Feb 21, 2011 at 3:39 PM, Bas van Dijk v.dijk@gmail.com wrote: On 19 February 2011 00:04, Bas van Dijk v.dijk@gmail.com 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.dpatch Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 21 February 2011 21:55, Johan Tibell johan.tib...@gmail.com wrote: ...include TimeoutKey in the TimeoutCallback type. Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dpatch Thanks, Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 21 February 2011 22:11, Job Vranish job.vran...@gmail.com wrote: I'm curious, is it possible that your new timeout implementation would fix this problem?: doesntWork :: Int - Int doesntWork x = last $ cycle [x] test :: IO (Maybe Bool) test = timeout 1 $ evaluate $ doesntWork 5 == 5 -- never terminates, even with the timeout I just tested this with the new timeout and unfortunately it's not fixed. Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Mon, Feb 21, 2011 at 3:16 PM, Bas van Dijk v.dijk@gmail.com wrote: On 21 February 2011 21:55, Johan Tibell johan.tib...@gmail.com wrote: ...include TimeoutKey in the TimeoutCallback type. Done: http://hackage.haskell.org/trac/ghc/attachment/ticket/4963/faster_timeout.dpatch 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 18 February 2011 01:05, Johan Tibell johan.tib...@gmail.com wrote: On Thu, Feb 17, 2011 at 5:01 PM, Bas van Dijk v.dijk@gmail.com 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [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 1000 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Fri, Feb 18, 2011 at 9:04 PM, Bas van Dijk v.dijk@gmail.com 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. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 16/02/2011 23:27, Bas van Dijk wrote:
On 16 February 2011 20:26, Bas van Dijkv.dijk@gmail.com 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
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 17 February 2011 13:09, Simon Marlow marlo...@gmail.com 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
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 17 February 2011 20:34, Bas van Dijk v.dijk@gmail.com 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk v.dijk@gmail.com 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. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Thu, Feb 17, 2011 at 2:43 PM, Bryan O'Sullivan b...@serpentine.com wrote: On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk v.dijk@gmail.com 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. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 18 February 2011 00:56, Johan Tibell johan.tib...@gmail.com wrote: On Thu, Feb 17, 2011 at 2:43 PM, Bryan O'Sullivan b...@serpentine.com wrote: On Thu, Feb 17, 2011 at 11:53 AM, Bas van Dijk v.dijk@gmail.com 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 / 100.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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Thu, Feb 17, 2011 at 4:09 PM, Bas van Dijk v.dijk@gmail.com 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 18 February 2011 01:16, Johan Tibell johan.tib...@gmail.com wrote: On Thu, Feb 17, 2011 at 4:09 PM, Bas van Dijk v.dijk@gmail.com 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-Event.html Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Thu, Feb 17, 2011 at 4:19 PM, Bas van Dijk v.dijk@gmail.com 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-Event.html 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 18 February 2011 01:28, Johan Tibell johan.tib...@gmail.com wrote: On Thu, Feb 17, 2011 at 4:19 PM, Bas van Dijk v.dijk@gmail.com 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-Event.html Because it's not explicitly designed to be. Ok, that will make changing it a bit easier. Thanks, Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 18 February 2011 01:09, Bas van Dijk v.dijk@gmail.com 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 10 $ 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 us1.0 x willTimeout/new 26.91964 us0.9 x (large std dev: 5 us) willTimeout/event 12.94273 us1.9 x :-) wontTimeout/old 16.25766 us1.0 x wontTimeout/new 637.8685 ns 25.5 x :-) wontTimeout/event 1.565311 us 10.4 x :-) externalException/old 10.28582 ms1.0 x externalException/new 9.960918 ms1.0 x externalException/event 10.25484 ms1.0 x nestedTimeouts/old 108.1759 ms1.0 x nestedTimeouts/new 108.4585 ms1.0 x nestedTimeouts/event109.9614 ms1.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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Thu, Feb 17, 2011 at 5:01 PM, Bas van Dijk v.dijk@gmail.com 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Faster timeout but is it correct?
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 100) However the following benchmark, which never times out, shows nice speedups for both a non-threaded and a threaded version: timeout 100 (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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
I just submitted a patch for base: http://hackage.haskell.org/trac/ghc/ticket/4963 Regards, Bas ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 16 February 2011 20:26, Bas van Dijk v.dijk@gmail.com 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
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On Wed, Feb 16, 2011 at 9:27 PM, Bas van Dijk v.dijk@gmail.com 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. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Faster timeout but is it correct?
On 17 February 2011 00:46, Felipe Almeida Lessa felipe.le...@gmail.com wrote: On Wed, Feb 16, 2011 at 9:27 PM, Bas van Dijk v.dijk@gmail.com 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 ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
