[Haskell-cafe] Re: [reactive] problem with unamb -- doesn't kill
enough threads
Conal Elliott
conal at conal.net
Fri Dec 19 14:17:15 EST 2008
Peter,
Thanks for digging. In your results below, I see only three out of four
threads killed even in the best case. Each time, there is no report of the
'sleep 2' thread being killed.
When I run your code on Linux (Ubuntu 8.10), everything looks great when run
under ghci. If compiled, with and without -threaded and with and without
+RTS -N2, I sometimes get four kill messages and sometimes fewer. In the
latter case, I don't know if the other threads aren't getting killed or if
they're killed but not reported.
For example (removing messages other than "Killed"):
conal at compy-doble:~/Haskell/Misc$ rm Threads.o ; ghc Threads.hs
-threaded -o Threads && ./Threads +RTS -N2
Killed ThreadId 5
Killed ThreadId 4
conal at compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2
Killed ThreadId 5
Killed ThreadId 4
Killed ThreadId 7
Killed ThreadId 6
conal at compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2
Killed ThreadId 5
Killed ThreadId 7
Killed ThreadId 4
Killed ThreadId 6
conal at compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2
Killed ThreadId 5
Killed ThreadId 4
conal at compy-doble:~/Haskell/Misc$
Simon -- does this behavior look like a GHC bug to you?
- Conal
On Fri, Dec 19, 2008 at 9:45 AM, Peter Verswyvelen <bugfact at gmail.com>wrote:
> I played a bit the the bracket function that timeout uses, but got strange
> results (both on Windows and OSX).
>
> Ugly code fragment follows:
>
>
> -%<-------------------------------------------------------------------------------------------------
>
> import Prelude hiding (catch)
>
> import Control.Concurrent
> import Control.Concurrent.MVar
> import Control.Exception
> import System.IO
> import Data.Char
>
> withThread a b = bracket (forkIO a) kill (const b)
> where
> kill id = do
> putStrLn ("Killing "++show id++"\n")
> killThread id
> putStrLn ("Killed "++show id++"\n")
>
> race a b = do
> v <- newEmptyMVar
> let t x = x >>= putMVar v
> withThread (t a) $ withThread (t b) $ takeMVar v
>
> forkPut :: IO a -> MVar a -> IO ThreadId
> forkPut act v = forkIO ((act >>= putMVar v) `catch` uhandler `catch`
> bhandler)
> where
> uhandler (ErrorCall "Prelude.undefined") = return ()
> uhandler err = throw err
> bhandler BlockedOnDeadMVar = return ()
>
> sleep n = do
> tid <- myThreadId
> putStrLn ("Sleeping "++show n++" sec on "++show tid++"\n")
> threadDelay (n*1000000)
> putStrLn ("Slept "++show n++" sec on "++show tid++"\n")
>
> f = sleep 2 `race` sleep 3
>
> g = f `race` sleep 1
>
> main = do
> hSetBuffering stdout LineBuffering
> g
>
>
> -%<-------------------------------------------------------------------------------------------------
>
> Here's the output when running with GHCI:
>
> C:\temp>runghc racetest
> Sleeping 1 sec on ThreadId 26
> Sleeping 2 sec on ThreadId 27
> Sleeping 3 sec on ThreadId 28
> Slept 1 sec on ThreadId 26
> Killing ThreadId 26
> Killed ThreadId 26
> Killing ThreadId 25
> Killed ThreadId 25
> Killing ThreadId 28
> Killed ThreadId 28
>
> Fine, all threads got killed.
>
> Here's the output from an EXE compiled with GHC -threaded, but run without
> +RTS -N2
>
> C:\temp> racetest
> Sleeping 1 sec on ThreadId 5
> Sleeping 3 sec on ThreadId 7
> Sleeping 2 sec on ThreadId 6
> Slept 1 sec on ThreadId 5
> Killing ThreadId 5
> Killed ThreadId 5
> Killing ThreadId 4
> Killed ThreadId 4
> Killing ThreadId 7
>
> So "Killed ThreadId 7" is not printed here. What did I do wrong?
>
> Here's the output from an EXE compiled with GHC -threaded, but run with
> +RTS -N2
>
> C:\temp> racetest +RTS -N2
> Sleeping 1 sec on ThreadId 5
> Sleeping 3 sec on ThreadId 7
> Sleeping 2 sec on ThreadId 6
> Slept 1 sec on ThreadId 5
>
> Killing ThreadId 5
> Killed ThreadId 5
> Killing ThreadId 4
> Killed ThreadId 4
> Killing ThreadId 7
> Killed ThreadId 7
>
> This works again.
>
> Is this intended behavior?
>
> Cheers,
> Peter Verswyvelen
> CTO - Anygma
>
> On Fri, Dec 19, 2008 at 10:48 AM, Simon Marlow <marlowsd at gmail.com> wrote:
>
>> Sounds like you should use an exception handler so that when the parent
>> dies it also kills its children. Be very careful with race conditions ;-)
>>
>> For a good example of how to do this sort of thing, see
>>
>>
>> http://www.haskell.org/ghc/docs/latest/html/libraries/base/System-Timeout.html
>>
>> the docs are sadly missing the source links at the moment, I'm not sure
>> why, but you can find the source in
>>
>> http://darcs.haskell.org/packages/base/System/Timeout.hs
>>
>> Cheers,
>> Simon
>>
>> Conal Elliott wrote:
>>
>>> (I'm broadening the discussion to include haskell-cafe.)
>>>
>>> Andy -- What do you mean by "handling all thread forking locally"?
>>>
>>> - Conal
>>>
>>> On Thu, Dec 18, 2008 at 1:57 PM, Andy Gill <andygill at ku.edu <mailto:
>>> andygill at ku.edu>> wrote:
>>>
>>> Conal, et. al,
>>>
>>> I was looking for exactly this about 6~9 months ago. I got the
>>> suggestion to pose it as a challenge
>>> to the community by Duncan Coutts. What you need is thread groups,
>>> where for a ThreadId, you can send a signal
>>> to all its children, even missing generations if needed.
>>> I know of no way to fix this at the Haskell level without handling
>>> all thread forking locally.
>>> Perhaps a ICFP paper about the pending implementation :-) but I'm
>>> not sure about the research content here.
>>>
>>> Again, there is something deep about values with lifetimes.
>>> Andy Gill
>>>
>>>
>>> On Dec 18, 2008, at 3:43 PM, Conal Elliott wrote:
>>>
>>> I realized in the shower this morning that there's a serious flaw
>>>> in my unamb implementation as described in
>>>>
>>>> http://conal.net/blog/posts/functional-concurrency-with-unambiguous-choice.
>>>> I'm looking for ideas for fixing the flaw. Here's the code for
>>>> racing computations:
>>>>
>>>> race :: IO a -> IO a -> IO a
>>>> a `race` b = do v <- newEmptyMVar
>>>> ta <- forkPut a v
>>>> tb <- forkPut b v
>>>> x <- takeMVar v
>>>> killThread ta
>>>> killThread tb
>>>> return x
>>>>
>>>> forkPut :: IO a -> MVar a -> IO ThreadId
>>>> forkPut act v = forkIO ((act >>= putMVar v) `catch` uhandler
>>>> `catch` bhandler)
>>>> where
>>>> uhandler (ErrorCall "Prelude.undefined") = return ()
>>>> uhandler err = throw err
>>>> bhandler BlockedOnDeadMVar = return ()
>>>>
>>>> The problem is that each of the threads ta and tb may have spawned
>>>> other threads, directly or indirectly. When I kill them, they
>>>> don't get a chance to kill their sub-threads.
>>>>
>>>> Perhaps I want some form of garbage collection of threads, perhaps
>>>> akin to Henry Baker's paper "The Incremental Garbage Collection of
>>>> Processes". As with memory GC, dropping one consumer would
>>>> sometimes result is cascading de-allocations. That cascade is
>>>> missing from my implementation.
>>>>
>>>> Or maybe there's a simple and dependable manual solution,
>>>> enhancing the method above.
>>>>
>>>> Any ideas?
>>>>
>>>> - Conal
>>>>
>>>>
>>>> _______________________________________________
>>>> Reactive mailing list
>>>> Reactive at haskell.org <mailto:Reactive at haskell.org>
>>>> http://www.haskell.org/mailman/listinfo/reactive
>>>>
>>>
>>>
>>>
>>> ------------------------------------------------------------------------
>>>
>>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20081219/6d2eac74/attachment.htm
More information about the Haskell-Cafe
mailing list