From: stolz <unknown>
Date: Wed, 26 Jun 2002 08:18:45 +0000 (+0000)
Subject: [project @ 2002-06-26 08:18:45 by stolz]
X-Git-Tag: nhc98-1-18-release~964
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0f5a7cf8ffe3af9b47ba3b83bccb75d0bbf7e549;p=haskell-directory.git

[project @ 2002-06-26 08:18:45 by stolz]
- Make TSO "stable" again: The thread label was changing the size of the
   TSO if you were building a debugging-RTS, leading to binary
   incompatibility. Now we map TSOs to strings using Hash.c.

- API change for labelThread: Label arbitrary threads.
---

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index e79662c..46120c1 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -24,7 +24,7 @@ module GHC.Conc
 	, par  		-- :: a -> b -> b
 	, pseq 		-- :: a -> b -> b
 	, yield         -- :: IO ()
-	, labelThread	-- :: String -> IO ()
+	, labelThread	-- :: ThreadId -> String -> IO ()
 	, forkProcess	-- :: IO Int
 
 	-- Waiting
@@ -123,11 +123,11 @@ yield :: IO ()
 yield = IO $ \s -> 
    case (yield# s) of s1 -> (# s1, () #)
 
-labelThread :: String -> IO ()
-labelThread str = IO $ \ s ->
+labelThread :: ThreadId -> String -> IO ()
+labelThread (ThreadId t) str = IO $ \ s ->
    let ps  = packCString# str
        adr = byteArrayContents# ps in
-     case (labelThread# adr s) of s1 -> (# s1, () #)
+     case (labelThread# t adr s) of s1 -> (# s1, () #)
 
 forkProcess :: IO Int
 forkProcess = IO $ \s -> case (forkProcess# s) of (# s1, id #) -> (# s1, (I# id) #)