From d9f20043f1bff6d3731e62de4db4d98fcff57498 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 10 Jul 2008 15:14:06 +0000 Subject: [PATCH] add threadStatus# primop, for querying the status of a ThreadId# --- compiler/prelude/primops.txt.pp | 5 +++++ includes/Constants.h | 1 + includes/StgMiscClosures.h | 1 + rts/Linker.c | 1 + rts/PrimOps.cmm | 33 +++++++++++++++++++++++++++++++++ 5 files changed, 41 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 302640d..39ae85d 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -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" ------------------------------------------------------------------------ diff --git a/includes/Constants.h b/includes/Constants.h index 66254f4..f0f3ce7 100644 --- a/includes/Constants.h +++ b/includes/Constants.h @@ -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 diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h index 0aa0703..61518e8 100644 --- a/includes/StgMiscClosures.h +++ b/includes/StgMiscClosures.h @@ -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); diff --git a/rts/Linker.c b/rts/Linker.c index d1550e1..318b3f0 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -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) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 54c165c..53de724 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -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 -- 1.7.10.4