summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoland Zumkeller <Roland.Zumkeller@gmail.com>2019-06-22 19:35:07 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-11-19 20:39:19 -0500
commitd1f3c63701b7f0fd675f792af7f33c5b11eaff83 (patch)
tree077460cd5f8cf6525908c08cc4a6f4e3ade441a6
parente57b7cc6d8b1222e0939d19c265b51d2c3c2b4c0 (diff)
downloadhaskell-d1f3c63701b7f0fd675f792af7f33c5b11eaff83.tar.gz
Use pointer equality in Eq/Ord for ThreadId
Changes (==) to use only pointer equality. This is safe because two threads are the same iff they have the same id. Changes `compare` to check pointer equality first and fall back on ids only in case of inequality. See discussion in #16761.
-rw-r--r--includes/rts/Threads.h1
-rw-r--r--libraries/base/GHC/Conc/Sync.hs19
-rw-r--r--rts/RtsSymbols.c1
-rw-r--r--rts/Threads.c25
4 files changed, 29 insertions, 17 deletions
diff --git a/includes/rts/Threads.h b/includes/rts/Threads.h
index 7f016decb6..6d4aa76761 100644
--- a/includes/rts/Threads.h
+++ b/includes/rts/Threads.h
@@ -41,6 +41,7 @@ StgRegTable * resumeThread (void *);
//
// Thread operations from Threads.c
//
+bool eq_thread (StgPtr tso1, StgPtr tso2);
int cmp_thread (StgPtr tso1, StgPtr tso2);
long rts_getThreadId (StgPtr tso);
void rts_enableThreadAllocationLimit (StgPtr tso);
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index 87491993f8..de8ca8e5a0 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -154,26 +154,21 @@ foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt
id2TSO :: ThreadId -> ThreadId#
id2TSO (ThreadId t) = t
+foreign import ccall unsafe "eq_thread" eq_thread :: ThreadId# -> ThreadId# -> CBool
+
foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> CInt
-- Returns -1, 0, 1
-cmpThread :: ThreadId -> ThreadId -> Ordering
-cmpThread t1 t2 =
- case cmp_thread (id2TSO t1) (id2TSO t2) of
- -1 -> LT
- 0 -> EQ
- _ -> GT -- must be 1
-
-- | @since 4.2.0.0
instance Eq ThreadId where
- t1 == t2 =
- case t1 `cmpThread` t2 of
- EQ -> True
- _ -> False
+ ThreadId t1 == ThreadId t2 = eq_thread t1 t2 /= 0
-- | @since 4.2.0.0
instance Ord ThreadId where
- compare = cmpThread
+ compare (ThreadId t1) (ThreadId t2) = case cmp_thread t1 t2 of
+ -1 -> LT
+ 0 -> EQ
+ _ -> GT
-- | Every thread has an allocation counter that tracks how much
-- memory has been allocated by the thread. The counter is
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index b2f90a892d..aef49606b3 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -606,6 +606,7 @@
SymI_HasProto(stg_compactFixupPointerszh) \
SymI_HasProto(stg_compactSizzezh) \
SymI_HasProto(closure_flags) \
+ SymI_HasProto(eq_thread) \
SymI_HasProto(cmp_thread) \
SymI_HasProto(createAdjustor) \
SymI_HasProto(stg_decodeDoublezu2Intzh) \
diff --git a/rts/Threads.c b/rts/Threads.c
index cce32ca2b3..22d58bb48b 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -139,21 +139,36 @@ createThread(Capability *cap, W_ size)
}
/* ---------------------------------------------------------------------------
+ * Equality on Thread ids.
+ *
+ * This is used from STG land in the implementation of the Eq instance
+ * for ThreadIds.
+ * ------------------------------------------------------------------------ */
+
+bool
+eq_thread(StgPtr tso1, StgPtr tso2)
+{
+ return tso1 == tso2;
+}
+
+/* ---------------------------------------------------------------------------
* Comparing Thread ids.
*
- * This is used from STG land in the implementation of the
- * instances of Eq/Ord for ThreadIds.
+ * This is used from STG land in the implementation of the Ord instance
+ * for ThreadIds.
* ------------------------------------------------------------------------ */
int
cmp_thread(StgPtr tso1, StgPtr tso2)
{
+ if (tso1 == tso2) return 0;
+
StgThreadID id1 = ((StgTSO *)tso1)->id;
StgThreadID id2 = ((StgTSO *)tso2)->id;
- if (id1 < id2) return (-1);
- if (id1 > id2) return 1;
- return 0;
+ ASSERT(id1 != id2);
+
+ return id1 < id2 ? -1 : 1;
}
/* ---------------------------------------------------------------------------