+/*
+ Check the sanity of a blocking queue starting at bqe with closure being
+ the closure holding the blocking queue.
+ Note that in GUM we can have several different closure types in a
+ blocking queue
+*/
+#if defined(PAR)
+void
+checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure)
+{
+ rtsBool end = rtsFalse;
+ StgInfoTable *info = get_itbl(closure);
+
+ ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR
+ || info->type == FETCH_ME_BQ || info->type == RBH);
+
+ do {
+ switch (get_itbl(bqe)->type) {
+ case BLOCKED_FETCH:
+ case TSO:
+ checkClosure((StgClosure *)bqe);
+ bqe = bqe->link;
+ end = (bqe==END_BQ_QUEUE);
+ break;
+
+ case CONSTR:
+ checkClosure((StgClosure *)bqe);
+ end = rtsTrue;
+ break;
+
+ default:
+ barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n",
+ get_itbl(bqe)->type, closure, info_type(closure));
+ }
+ } while (!end);
+}
+#elif defined(GRAN)
+void
+checkBQ (StgTSO *bqe, StgClosure *closure)
+{
+ rtsBool end = rtsFalse;
+ StgInfoTable *info = get_itbl(closure);
+
+ ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
+
+ do {
+ switch (get_itbl(bqe)->type) {
+ case BLOCKED_FETCH:
+ case TSO:
+ checkClosure((StgClosure *)bqe);
+ bqe = bqe->link;
+ end = (bqe==END_BQ_QUEUE);
+ break;
+
+ default:
+ barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n",
+ get_itbl(bqe)->type, closure, info_type(closure));
+ }
+ } while (!end);
+}
+#else
+void
+checkBQ (StgTSO *bqe, StgClosure *closure)
+{
+ rtsBool end = rtsFalse;
+ StgInfoTable *info = get_itbl(closure);
+
+ ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
+
+ do {
+ switch (get_itbl(bqe)->type) {
+ case TSO:
+ checkClosure((StgClosure *)bqe);
+ bqe = bqe->link;
+ end = (bqe==END_TSO_QUEUE);
+ break;
+
+ default:
+ barf("checkBQ: strange closure %d in blocking queue for closure %p\n",
+ get_itbl(bqe)->type, closure, info->type);
+ }
+ } while (!end);
+}
+
+#endif
+
+
+
+/*
+ This routine checks the sanity of the LAGA and GALA tables. They are
+ implemented as lists through one hash table, LAtoGALAtable, because entries
+ in both tables have the same structure:
+ - the LAGA table maps local addresses to global addresses; it starts
+ with liveIndirections
+ - the GALA table maps global addresses to local addresses; it starts
+ with liveRemoteGAs
+*/
+
+#if defined(PAR)
+#include "Hash.h"
+
+/* hidden in parallel/Global.c; only accessed for testing here */
+extern GALA *liveIndirections;
+extern GALA *liveRemoteGAs;
+extern HashTable *LAtoGALAtable;
+
+void
+checkLAGAtable(rtsBool check_closures)
+{
+ GALA *gala, *gala0;
+ nat n=0, m=0; // debugging
+
+ for (gala = liveIndirections; gala != NULL; gala = gala->next) {
+ n++;
+ gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
+ ASSERT(!gala->preferred || gala == gala0);
+ ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
+ ASSERT(gala->next!=gala); // detect direct loops
+ if ( check_closures ) {
+ checkClosure((StgClosure *)gala->la);
+ }
+ }
+
+ for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
+ m++;
+ gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
+ ASSERT(!gala->preferred || gala == gala0);
+ ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
+ ASSERT(gala->next!=gala); // detect direct loops
+ /*
+ if ( check_closures ) {
+ checkClosure((StgClosure *)gala->la);
+ }
+ */
+ }
+}
+#endif
+