Commit c19f3a54 authored by dterei's avatar dterei

Fix callback001

parent ce9eeebe
...@@ -13,27 +13,27 @@ module Main where ...@@ -13,27 +13,27 @@ module Main where
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
import Foreign.Ptr
import Data.IORef import Data.IORef
import Foreign.Ptr
import System.Environment import System.Environment
import System.IO import System.IO
main = do main = do
[s] <- getArgs [s] <- getArgs
let n = read s :: Int let n = read s :: Int
fork = if rtsSupportsBoundThreads then forkOS else forkIO
sem <- newQSemN 0 sem <- newQSemN 0
let fork = if rtsSupportsBoundThreads then forkOS else forkIO replicateM n $ putStr "." >> hFlush stdout >> fork (thread sem) >> thread sem
replicateM n (putStr "." >> hFlush stdout >> fork (thread sem) >> thread sem) putChar '\n'
waitQSemN sem (n*2) waitQSemN sem (n*2)
thread sem = do thread sem = do
var <- newIORef 0 var <- newIORef 0
let f = modifyIORef var (1+) let f = modifyIORef var (1+)
callC =<< mkFunc f callC =<< mkFunc f
signalQSemN sem 1 signalQSemN sem 1
type FUNC = IO () type FUNC = IO ()
foreign import ccall unsafe "wrapper" foreign import ccall unsafe "wrapper"
mkFunc :: FUNC -> IO (FunPtr FUNC) mkFunc :: FUNC -> IO (FunPtr FUNC)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment