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 <[email protected]> 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"): > > co...@compy-doble:~/Haskell/Misc$ rm Threads.o ; ghc Threads.hs > -threaded -o Threads && ./Threads +RTS -N2 > Killed ThreadId 5 > Killed ThreadId 4 > > co...@compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2 > Killed ThreadId 5 > Killed ThreadId 4 > Killed ThreadId 7 > Killed ThreadId 6 > > co...@compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2 > Killed ThreadId 5 > Killed ThreadId 7 > Killed ThreadId 4 > Killed ThreadId 6 > > co...@compy-doble:~/Haskell/Misc$ ./Threads +RTS -N2 > Killed ThreadId 5 > Killed ThreadId 4 > > co...@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 <[email protected]>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 <[email protected]>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 <[email protected] <mailto: >>>> [email protected]>> 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 >>>>> [email protected] <mailto:[email protected]> >>>>> http://www.haskell.org/mailman/listinfo/reactive >>>>> >>>> >>>> >>>> >>>> ------------------------------------------------------------------------ >>>> >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> [email protected] >>>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> [email protected] >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >> >> >
_______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
