Bump Cabal submodule
[ghc.git] / rts / TopHandler.c
1 #include "Rts.h"
2 #include "Stable.h"
3 #include "TopHandler.h"
4
5 #ifdef THREADED_RTS
6 static Mutex m; // Protects the operations on topHandlerPtr,
7 // which aren't atomic
8 #endif
9 static StgStablePtr topHandlerPtr;
10
11 void rts_setMainThread(StgWeak *weak) {
12 ACQUIRE_LOCK(&m);
13 if (topHandlerPtr != NULL) {
14 freeStablePtr(topHandlerPtr); // OK to do under the lock
15 }
16 topHandlerPtr = getStablePtr((StgPtr)weak);
17 // referent is a Weak#
18 ASSERT(weak->header.info == &stg_WEAK_info);
19
20 // See Note [rts_setMainThread has an unsound type] in
21 // libraries/base/GHC/TopHandler.hs.
22 ASSERT(weak->key->header.info == &stg_TSO_info);
23
24 RELEASE_LOCK(&m);
25 }
26
27 StgTSO *getTopHandlerThread(void) {
28 ACQUIRE_LOCK(&m);
29 StgWeak *weak = (StgWeak*)deRefStablePtr(topHandlerPtr);
30 RELEASE_LOCK(&m);
31 const StgInfoTable *info = weak->header.info;
32 if (info == &stg_WEAK_info) {
33 StgClosure *key = ((StgWeak*)weak)->key;
34
35 // See Note [rts_setMainThread has an unsound type] in
36 // libraries/base/GHC/TopHandler.hs.
37 ASSERT(key->header.info == &stg_TSO_info);
38
39 return (StgTSO *)key;
40 } else if (info == &stg_DEAD_WEAK_info) {
41 return NULL;
42 } else {
43 barf("getTopHandlerThread: neither a WEAK nor a DEAD_WEAK: %p %p %d",
44 weak, info, info->type);
45 return NULL;
46 }
47 }
48
49 void initTopHandler(void) {
50 #ifdef THREADED_RTS
51 initMutex(&m);
52 #endif
53 topHandlerPtr = NULL;
54 }
55
56 void exitTopHandler(void) {
57 freeStablePtr(topHandlerPtr);
58 topHandlerPtr = NULL;
59 #ifdef THREADED_RTS
60 closeMutex(&m);
61 #endif
62 }