diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index f4066c50bb0c4027194aae3c2e2be47ca2d2a301..6dd2209ec9d10bd4fd432f38310b28a85b85c392 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.35 1999/08/24 09:36:41 simonmar Exp $ + * $Id: PrimOps.h,v 1.36 1999/08/25 10:23:51 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -711,6 +711,8 @@ EF_(seqzh_fast); #define myThreadIdzh(t) (t = CurrentTSO) +extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); + /* Hmm, I'll think about these later. */ /* ----------------------------------------------------------------------------- Pointer equality diff --git a/ghc/lib/concurrent/Concurrent.lhs b/ghc/lib/concurrent/Concurrent.lhs index c9c2240af6c5a7090bc41a54f0547d57ab2391dc..de342c6e4328e555dce6def635a7ff0649e326c2 100644 --- a/ghc/lib/concurrent/Concurrent.lhs +++ b/ghc/lib/concurrent/Concurrent.lhs @@ -63,10 +63,38 @@ import PrelArr ( ByteArray ) import PrelPack ( packString ) import PrelIOBase ( unsafePerformIO , unsafeInterleaveIO ) import PrelBase ( fork# ) +import PrelGHC ( Addr#, unsafeCoerce# ) infixr 0 `fork` \end{code} +Thread Ids, specifically the instances of Eq and Ord for these things. +The ThreadId type itself is defined in std/PrelConc.lhs. + +Rather than define a new primitve, we use a little helper function +cmp_thread in the RTS. + +\begin{code} +foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr# -> Addr# -> Int +-- Returns -1, 0, 1 + +cmpThread :: ThreadId -> ThreadId -> Ordering +cmpThread (ThreadId t1) (ThreadId t2) = + case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of + -1 -> LT + 0 -> EQ + 1 -> GT + +instance Eq ThreadId where + t1 == t2 = + case t1 `cmpThread` t2 of + EQ -> True + _ -> False + +instance Ord ThreadId where + compare = cmpThread +\end{code} + \begin{code} forkIO :: IO () -> IO ThreadId forkIO action = IO $ \ s -> diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 064f1e6c392a78ec95605c1847a7200b74ccddf1..70df69675272937e55978bb45bbd2af920c2efbd 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.22 1999/06/25 09:17:58 simonmar Exp $ + * $Id: Schedule.c,v 1.23 1999/08/25 10:23:53 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -75,6 +75,23 @@ StgTSO *MainTSO; * -------------------------------------------------------------------------- */ static void unblockThread(StgTSO *tso); +/* ----------------------------------------------------------------------------- + * Comparing Thread ids. + * + * This is used from STG land in the implementation of the + * instances of Eq/Ord for ThreadIds. + * -------------------------------------------------------------------------- */ + +int cmp_thread(const StgTSO *tso1, const StgTSO *tso2) +{ + StgThreadID id1 = tso1->id; + StgThreadID id2 = tso2->id; + + if (id1 < id2) return (-1); + if (id1 > id2) return 1; + return 0; +} + /* ----------------------------------------------------------------------------- Create a new thread.