-- exposed a bug in GHC 6.4 threaded RTS, fixed in Schedule.c rev. 1.232

module Main where

import Control.Concurrent
import Control.Monad
import Foreign.Ptr
import Data.IORef

main = do
  ms <- replicateM 100 $ do putStrLn "." 
       		      	    m <- newEmptyMVar 
			    forkOS (thread >> putMVar m ())
			    thread
			    return m
  mapM takeMVar ms

thread = do var <- newIORef 0
            let f = modifyIORef var (1+)
            callC =<< mkFunc f

type FUNC  =  IO ()

foreign import ccall unsafe "wrapper"
   mkFunc :: FUNC -> IO (FunPtr FUNC)

foreign import ccall safe "ffi014_cbits.h callC"
   callC:: FunPtr FUNC -> IO ()