[project @ 2002-04-10 11:43:49 by stolz]

Two new scheduler-API primops:

1) GHC.Conc.forkProcess/forkProcess# :: IO Int
   This is a low-level call to fork() to replace Posix.forkProcess().
   In a Concurrent Haskell setting, only the thread invoking forkProcess()
   is alive in the child process. Other threads will be GC'ed!
      This brings the RTS closer to pthreads, where a call to fork()
   doesn't clone any pthreads, either.
      The result is 0 for the child and the child's pid for the parent.
   The primop will barf() when used on mingw32, sorry.

2) GHC.Conc.labelThread/forkProcess# :: String -> IO ()
   Useful for scheduler debugging: If the RTS is compiled with DEBUGging
   support, this primitive assigns a name to the current thread which
   will be used in debugging output (+RTS -D1). For larger applications,
   simply numbering threads is not sufficient.
     Notice: The Haskell side of this call is always available, but if
   you are not compiling with debugging support, the actual primop will
   turn into a no-op.

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 5a74f32..669be48 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Conc.lhs,v 1.3 2001/12/21 15:07:22 simonmar Exp $
+% $Id: Conc.lhs,v 1.4 2002/04/10 11:43:49 stolz Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -21,6 +21,8 @@ module GHC.Conc
        , par           -- :: a -> b -> b
        , pseq          -- :: a -> b -> b
        , yield         -- :: IO ()
+       , labelThread   -- :: String -> IO ()
+       , forkProcess   -- :: IO Int
 
        -- Waiting
        , threadDelay           -- :: Int -> IO ()
@@ -47,6 +49,7 @@ import GHC.Err                ( parError, seqError )
 import GHC.IOBase      ( IO(..), MVar(..) )
 import GHC.Base                ( Int(..) )
 import GHC.Exception    ( Exception(..), AsyncException(..) )
+import GHC.Pack                ( packCString# )
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -81,6 +84,15 @@ yield :: IO ()
 yield = IO $ \s -> 
    case (yield# s) of s1 -> (# s1, () #)
 
+labelThread :: String -> IO ()
+labelThread str = IO $ \ s ->
+   let ps  = packCString# str
+       adr = byteArrayContents# ps in
+     case (labelThread# adr s) of s1 -> (# s1, () #)
+
+forkProcess :: IO Int
+forkProcess = IO $ \s -> case (forkProcess# s) of (# s1, id #) -> (# s1, (I# id) #)
+
 --     Nota Bene: 'pseq' used to be 'seq'
 --                but 'seq' is now defined in PrelGHC
 --