[Haskell-cafe] Re: [reactive] problem with unamb -- doesn't kill
enough threads
Conal Elliott
conal at conal.net
Sat Dec 20 00:25:49 EST 2008
Oh -- I think the problem here was simply that the process itself exited
before all of the threads had a chance to get killed. When I add a short
sleep to the end of main, or even just a 'yield', I see that all threads
reported as killed. What clued me in was finally paying attention to the
observation that under ghci I get the new prompt *before* some of the kill
reports.
- Conal
On Fri, Dec 19, 2008 at 11:17 AM, Conal Elliott <conal at conal.net> wrote:
> 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/2cf5562c/attachment.htm
More information about the Haskell-Cafe
mailing list