From: Simon Marlow <simonmar@microsoft.com>
Date: Mon, 27 Mar 2006 13:50:18 +0000 (+0000)
Subject: add  forkOnIO :: Int -> IO () -> IO ThreadId
X-Git-Tag: directory_2007-05-24~314
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=086fb46b8ac94df6b3aef6873a8e8e277ca7a687;p=haskell-directory.git

add  forkOnIO :: Int -> IO () -> IO ThreadId
---

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 896df03..d36f95f 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -25,6 +25,7 @@ module GHC.Conc
 
 	-- Forking and suchlike
 	, forkIO	-- :: IO a -> IO ThreadId
+	, forkOnIO	-- :: Int -> IO a -> IO ThreadId
 	, childHandler  -- :: Exception -> IO ()
 	, myThreadId 	-- :: IO ThreadId
 	, killThread	-- :: ThreadId -> IO ()
@@ -146,6 +147,12 @@ forkIO action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
+forkOnIO :: Int -> IO () -> IO ThreadId
+forkOnIO (I# cpu) action = IO $ \ s -> 
+   case (forkOn# cpu action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
+ where
+  action_plus = catchException action childHandler
+
 childHandler :: Exception -> IO ()
 childHandler err = catchException (real_handler err) childHandler