Commit d9f20043 authored by Simon Marlow's avatar Simon Marlow

add threadStatus# primop, for querying the status of a ThreadId#

parent a5b95b1f
......@@ -1531,6 +1531,11 @@ primop NoDuplicateOp "noDuplicate#" GenPrimOp
with
out_of_line = True
primop ThreadStatusOp "threadStatus#" GenPrimOp
ThreadId# -> State# RealWorld -> (# State# RealWorld, Int# #)
with
out_of_line = True
------------------------------------------------------------------------
section "Weak pointers"
------------------------------------------------------------------------
......
......@@ -193,6 +193,7 @@
/*
* Constants for the why_blocked field of a TSO
* NB. keep these in sync with GHC/Conc.lhs: threadStatus
*/
#define NotBlocked 0
#define BlockedOnMVar 1
......
......@@ -585,6 +585,7 @@ RTS_FUN(unblockAsyncExceptionszh_fast);
RTS_FUN(myThreadIdzh_fast);
RTS_FUN(labelThreadzh_fast);
RTS_FUN(isCurrentThreadBoundzh_fast);
RTS_FUN(threadStatuszh_fast);
RTS_FUN(mkWeakzh_fast);
RTS_FUN(finalizzeWeakzh_fast);
......
......@@ -768,6 +768,7 @@ typedef struct _RtsSymbolVal {
SymX(stg_upd_frame_info) \
SymX(suspendThread) \
SymX(takeMVarzh_fast) \
SymX(threadStatuszh_fast) \
SymX(timesIntegerzh_fast) \
SymX(tryPutMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
......
......@@ -1034,6 +1034,39 @@ isCurrentThreadBoundzh_fast
RET_N(r);
}
threadStatuszh_fast
{
/* args: R1 :: ThreadId# */
W_ tso;
W_ why_blocked;
W_ what_next;
W_ ret;
tso = R1;
loop:
if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
tso = StgTSO__link(tso);
goto loop;
}
what_next = TO_W_(StgTSO_what_next(tso));
why_blocked = TO_W_(StgTSO_why_blocked(tso));
// Note: these two reads are not atomic, so they might end up
// being inconsistent. It doesn't matter, since we
// only return one or the other. If we wanted to return the
// contents of block_info too, then we'd have to do some synchronisation.
if (what_next == ThreadComplete) {
ret = 16; // NB. magic, matches up with GHC.Conc.threadStatus
} else {
if (what_next == ThreadKilled) {
ret = 17;
} else {
ret = why_blocked;
}
}
RET_N(ret);
}
/* -----------------------------------------------------------------------------
* TVar primitives
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment