> I later ran into another problem that may or may not be 
> related with the
> first. This is the program I am running:
> 
>     module Main where
>     import Posix
> 
>     main = do
>         installHandler sigCONT (Catch (putStrLn "- resumed 
> -")) Nothing
>         forever $ do
>             c <- getChar
>             putChar c
> 
>     forever = sequence_ . repeat
> 
> This is the output from a conversation with the shell:
> 
>     % ./program &
>     [2] 8959
>     [2]  + Suspended (tty input)         ./program
>     % fg
>     ./program
>     a
>     a
>     b
>     b
>     c
>     c
>     d
>     d
>     e
>     e- resumed -

Interesting!  What's happening is the shell is putting stdin back into
blocking mode during the suspend/resume, which stops GHC's I/O subsystem
from letting other threads run when the process is restarted.  I've
committed a fix, which catches SIGCONT in the RTS and put stdin back
into O_NONBLOCK mode.

Cheers,
        Simon

_______________________________________________
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to