[Haskell-cafe] concurrency vs. I/O in GHC
Claude Heiland-Allen
claudiusmaximus at goto10.org
Sun Oct 24 04:56:26 EDT 2010
On 23/10/10 23:17, Donn Cave wrote:
> Quoth Claude Heiland-Allen<claudiusmaximus at goto10.org>,
> ...
>> The conclusion I drew was that "unsafe" foreign functions block the
>> current "capability" (OS thread) and any "threads" (Haskell forkIO etc)
>> currently scheduled on that capability, but other capabilities and
>> threads continue executing as normal.
... until GC time when all capabilities must be ready. (?)
> If a trivial test program would help, here I call the sleep() function,
> which I believe on a POSIX platform suspends the thread until receipt
> of a SIGALRM.
I wrote a program which shows some interesting behaviour:
----8<----
{-# LANGUAGE ForeignFunctionInterface #-}
module Main (main) where
import GHC.Conc (forkOnIO, numCapabilities)
import Control.Concurrent (threadDelay)
import Foreign.C (CInt)
import System.Environment (getArgs)
foreign import ccall unsafe "sleep" sleep :: CInt -> IO CInt
delayer :: Int -> IO ()
delayer n = do
print ("delayer", n)
threadDelay 100000 -- 10Hz
delayer n
sleeper :: Int -> IO ()
sleeper n = do
print ("sleeper", n)
_ <- sleep 1 -- 1Hz
sleeper n
main :: IO ()
main = do
m <- (read . head) `fmap` getArgs
mapM_ (\n -> forkOnIO n $ delayer n) [1 .. numCapabilities]
mapM_ (\n -> forkOnIO n $ sleeper n) [1 .. numCapabilities - m]
threadDelay 100000000 -- 100s
----8<----
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 6.12.3
$ uname -a
Linux zebimus 2.6.32-25-generic #44-Ubuntu SMP Fri Sep 17 20:05:27 UTC
2010 x86_64 GNU/Linux
$ ghc -O2 -Wall -threaded --make DelayedSleep.hs
$ ./DelayedSleep +RTS -N4 -S -RTS 3
[snip]
----8<----
By interesting I mean there is lots of output from the delayer threads
on capabilities without sleeper threads (as you would expect), with the
delayer threads on capabilities also having sleeper threads being much
less frequent (as you might also expect). But then there are some long
pauses where there is no output from any thread: my hypothesis is that
the whole runtime is blocked waiting for all threads to be ready for GC
(because +RTS -S shows some GC stats after the end of those pauses).
Claude
--
http://claudiusmaximus.goto10.org
More information about the Haskell-Cafe
mailing list