Make globals use sharedCAF
[ghc.git] / rts / Threads.c
index d6fe0e7..f5eb9d3 100644 (file)
@@ -35,11 +35,11 @@ static StgThreadID next_thread_id = 1;
  *    RESERVED_STACK_WORDS    (so we can get back from the stack overflow)
  *  + sizeofW(StgStopFrame)   (the stg_stop_thread_info frame)
  *  + 1                       (the closure to enter)
- *  + 1                              (stg_ap_v_ret)
- *  + 1                              (spare slot req'd by stg_ap_v_ret)
+ *  + 1                       (stg_ap_v_ret)
+ *  + 1                       (spare slot req'd by stg_ap_v_ret)
  *
  * A thread with this stack will bomb immediately with a stack
- * overflow, which will increase its stack size.  
+ * overflow, which will increase its stack size.
  */
 #define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3)
 
@@ -53,21 +53,19 @@ static StgThreadID next_thread_id = 1;
 
    createGenThread() and createIOThread() (in SchedAPI.h) are
    convenient packaged versions of this function.
-
-   currently pri (priority) is only used in a GRAN setup -- HWL
    ------------------------------------------------------------------------ */
 StgTSO *
-createThread(Capability *cap, nat size)
+createThread(Capability *cap, W_ size)
 {
     StgTSO *tso;
     StgStack *stack;
-    nat stack_size;
+    uint32_t stack_size;
 
     /* sched_mutex is *not* required */
 
     /* catch ridiculously small stack sizes */
-    if (size < MIN_STACK_WORDS + sizeofW(StgStack)) {
-        size = MIN_STACK_WORDS + sizeofW(StgStack);
+    if (size < MIN_STACK_WORDS + sizeofW(StgStack) + sizeofW(StgTSO)) {
+        size = MIN_STACK_WORDS + sizeofW(StgStack) + sizeofW(StgTSO);
     }
 
     /* The size argument we are given includes all the per-thread
@@ -84,7 +82,7 @@ createThread(Capability *cap, nat size)
     stack_size = round_to_mblocks(size - sizeofW(StgTSO));
     stack = (StgStack *)allocate(cap, stack_size);
     TICK_ALLOC_STACK(stack_size);
-    SET_HDR(stack, &stg_STACK_info, CCS_SYSTEM);
+    SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS);
     stack->stack_size   = stack_size - sizeofW(StgStack);
     stack->sp           = stack->stack + stack->stack_size;
     stack->dirty        = 1;
@@ -106,16 +104,18 @@ createThread(Capability *cap, nat size)
     tso->saved_errno = 0;
     tso->bound = NULL;
     tso->cap = cap;
-    
+
     tso->stackobj       = stack;
     tso->tot_stack_size = stack->stack_size;
 
+    ASSIGN_Int64((W_*)&(tso->alloc_limit), 0);
+
     tso->trec = NO_TREC;
 
 #ifdef PROFILING
-    tso->prof.CCCS = CCS_MAIN;
+    tso->prof.cccs = CCS_MAIN;
 #endif
-    
+
     // put a stop frame on the stack
     stack->sp -= sizeofW(StgStopFrame);
     SET_HDR((StgClosure*)stack->sp,
@@ -128,7 +128,7 @@ createThread(Capability *cap, nat size)
     tso->global_link = g0->threads;
     g0->threads = tso;
     RELEASE_LOCK(&sched_mutex);
-    
+
     // ToDo: report the stack size in the event?
     traceEventCreateThread(cap, tso);
 
@@ -143,11 +143,11 @@ createThread(Capability *cap, nat size)
  * ------------------------------------------------------------------------ */
 
 int
-cmp_thread(StgPtr tso1, StgPtr tso2) 
-{ 
-  StgThreadID id1 = ((StgTSO *)tso1)->id; 
+cmp_thread(StgPtr tso1, StgPtr tso2)
+{
+  StgThreadID id1 = ((StgTSO *)tso1)->id;
   StgThreadID id2 = ((StgTSO *)tso2)->id;
+
   if (id1 < id2) return (-1);
   if (id1 > id2) return 1;
   return 0;
@@ -159,69 +159,94 @@ cmp_thread(StgPtr tso1, StgPtr tso2)
  * This is used in the implementation of Show for ThreadIds.
  * ------------------------------------------------------------------------ */
 int
-rts_getThreadId(StgPtr tso) 
+rts_getThreadId(StgPtr tso)
 {
   return ((StgTSO *)tso)->id;
 }
 
+/* ---------------------------------------------------------------------------
+ * Getting & setting the thread allocation limit
+ * ------------------------------------------------------------------------ */
+HsInt64 rts_getThreadAllocationCounter(StgPtr tso)
+{
+    // NB. doesn't take into account allocation in the current nursery
+    // block, so it might be off by up to 4k.
+    return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit));
+}
+
+void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i)
+{
+    ASSIGN_Int64((W_*)&(((StgTSO *)tso)->alloc_limit), i);
+}
+
+void rts_enableThreadAllocationLimit(StgPtr tso)
+{
+    ((StgTSO *)tso)->flags |= TSO_ALLOC_LIMIT;
+}
+
+void rts_disableThreadAllocationLimit(StgPtr tso)
+{
+    ((StgTSO *)tso)->flags &= ~TSO_ALLOC_LIMIT;
+}
+
 /* -----------------------------------------------------------------------------
    Remove a thread from a queue.
    Fails fatally if the TSO is not on the queue.
    -------------------------------------------------------------------------- */
 
-rtsBool // returns True if we modified queue
+bool // returns true if we modified queue
 removeThreadFromQueue (Capability *cap, StgTSO **queue, StgTSO *tso)
 {
     StgTSO *t, *prev;
 
     prev = NULL;
     for (t = *queue; t != END_TSO_QUEUE; prev = t, t = t->_link) {
-       if (t == tso) {
-           if (prev) {
-               setTSOLink(cap,prev,t->_link);
+        if (t == tso) {
+            if (prev) {
+                setTSOLink(cap,prev,t->_link);
                 t->_link = END_TSO_QUEUE;
-                return rtsFalse;
-           } else {
-               *queue = t->_link;
+                return false;
+            } else {
+                *queue = t->_link;
                 t->_link = END_TSO_QUEUE;
-                return rtsTrue;
-           }
-       }
+                return true;
+            }
+        }
     }
     barf("removeThreadFromQueue: not found");
 }
 
-rtsBool // returns True if we modified head or tail
-removeThreadFromDeQueue (Capability *cap, 
+bool // returns true if we modified head or tail
+removeThreadFromDeQueue (Capability *cap,
                          StgTSO **head, StgTSO **tail, StgTSO *tso)
 {
     StgTSO *t, *prev;
-    rtsBool flag = rtsFalse;
+    bool flag = false;
 
     prev = NULL;
     for (t = *head; t != END_TSO_QUEUE; prev = t, t = t->_link) {
-       if (t == tso) {
-           if (prev) {
-               setTSOLink(cap,prev,t->_link);
-                flag = rtsFalse;
-           } else {
-               *head = t->_link;
-                flag = rtsTrue;
-           }
+        if (t == tso) {
+            if (prev) {
+                setTSOLink(cap,prev,t->_link);
+                flag = false;
+            } else {
+                *head = t->_link;
+                flag = true;
+            }
             t->_link = END_TSO_QUEUE;
             if (*tail == tso) {
-               if (prev) {
-                   *tail = prev;
-               } else {
-                   *tail = END_TSO_QUEUE;
-               }
-                return rtsTrue;
-           } else {
+                if (prev) {
+                    *tail = prev;
+                } else {
+                    *tail = END_TSO_QUEUE;
+                }
+                return true;
+            } else {
                 return flag;
             }
-       }
+        }
     }
-    barf("removeThreadFromMVarQueue: not found");
+    barf("removeThreadFromDeQueue: not found");
 }
 
 /* ----------------------------------------------------------------------------
@@ -247,7 +272,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
         msg->tso = tso;
         sendMessage(cap, tso->cap, (Message*)msg);
         debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld on cap %d",
-                      (lnat)tso->id, tso->cap->no);
+                      (W_)tso->id, tso->cap->no);
         return;
     }
 #endif
@@ -255,6 +280,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
     switch (tso->why_blocked)
     {
     case BlockedOnMVar:
+    case BlockedOnMVarRead:
     {
         if (tso->_link == END_TSO_QUEUE) {
             tso->block_info.closure = (StgClosure*)END_TSO_QUEUE;
@@ -267,12 +293,12 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
     case BlockedOnMsgThrowTo:
     {
         const StgInfoTable *i;
-        
+
         i = lockClosure(tso->block_info.closure);
         unlockClosure(tso->block_info.closure, i);
         if (i != &stg_MSG_NULL_info) {
             debugTraceCap(DEBUG_sched, cap, "thread %ld still blocked on throwto (%p)",
-                          (lnat)tso->id, tso->block_info.throwto->header.info);
+                          (W_)tso->id, tso->block_info.throwto->header.info);
             return;
         }
 
@@ -333,7 +359,7 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to)
    wakes up all the threads on the specified queue.
    ------------------------------------------------------------------------- */
 
-void
+static void
 wakeBlockingQueue(Capability *cap, StgBlockingQueue *bq)
 {
     MessageBlackHole *msg;
@@ -342,7 +368,7 @@ wakeBlockingQueue(Capability *cap, StgBlockingQueue *bq)
     ASSERT(bq->header.info == &stg_BLOCKING_QUEUE_DIRTY_info  ||
            bq->header.info == &stg_BLOCKING_QUEUE_CLEAN_info  );
 
-    for (msg = bq->queue; msg != (MessageBlackHole*)END_TSO_QUEUE; 
+    for (msg = bq->queue; msg != (MessageBlackHole*)END_TSO_QUEUE;
          msg = msg->link) {
         i = msg->header.info;
         if (i != &stg_IND_info) {
@@ -375,8 +401,8 @@ checkBlockingQueues (Capability *cap, StgTSO *tso)
 
     debugTraceCap(DEBUG_sched, cap,
                   "collision occurred; checking blocking queues for thread %ld",
-                  (lnat)tso->id);
-    
+                  (W_)tso->id);
+
     for (bq = tso->bq; bq != (StgBlockingQueue*)END_TSO_QUEUE; bq = next) {
         next = bq->link;
 
@@ -385,14 +411,14 @@ checkBlockingQueues (Capability *cap, StgTSO *tso)
             // traversing this IND multiple times.
             continue;
         }
-        
+
         p = bq->bh;
 
         if (p->header.info != &stg_BLACKHOLE_info ||
             ((StgInd *)p)->indirectee != (StgClosure*)bq)
         {
             wakeBlockingQueue(cap,bq);
-        }   
+        }
     }
 }
 
@@ -419,17 +445,21 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val)
         updateWithIndirection(cap, thunk, val);
         return;
     }
-    
+
     v = ((StgInd*)thunk)->indirectee;
 
     updateWithIndirection(cap, thunk, val);
 
+    // sometimes the TSO is locked when we reach here, so its header
+    // might be WHITEHOLE.  Hence check for the correct owner using
+    // pointer equality first.
+    if ((StgTSO*)v == tso) {
+        return;
+    }
+
     i = v->header.info;
     if (i == &stg_TSO_info) {
-        owner = (StgTSO*)v;
-        if (owner != tso) {
-            checkBlockingQueues(cap, tso);
-        }
+        checkBlockingQueues(cap, tso);
         return;
     }
 
@@ -452,7 +482,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val)
  * rtsSupportsBoundThreads(): is the RTS built to support bound threads?
  * used by Control.Concurrent for error checking.
  * ------------------------------------------------------------------------- */
+
 HsBool
 rtsSupportsBoundThreads(void)
 {
@@ -466,14 +496,14 @@ rtsSupportsBoundThreads(void)
 /* ---------------------------------------------------------------------------
  * isThreadBound(tso): check whether tso is bound to an OS thread.
  * ------------------------------------------------------------------------- */
+
 StgBool
 isThreadBound(StgTSO* tso USED_IF_THREADS)
 {
 #if defined(THREADED_RTS)
   return (tso->bound != NULL);
 #endif
-  return rtsFalse;
+  return false;
 }
 
 /* -----------------------------------------------------------------------------
@@ -490,21 +520,12 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
 {
     StgStack *new_stack, *old_stack;
     StgUnderflowFrame *frame;
+    W_ chunk_size;
 
     IF_DEBUG(sanity,checkTSO(tso));
 
-    if (tso->tot_stack_size >= RtsFlags.GcFlags.maxStkSize
-        && !(tso->flags & TSO_BLOCKEX)) {
-        // NB. never raise a StackOverflow exception if the thread is
-        // inside Control.Exceptino.block.  It is impractical to protect
-        // against stack overflow exceptions, since virtually anything
-        // can raise one (even 'catch'), so this is the only sensible
-        // thing to do here.  See bug #767.
-        //
-
-        if (tso->flags & TSO_SQUEEZED) {
-            return;
-        }
+    if (RtsFlags.GcFlags.maxStkSize > 0
+        && tso->tot_stack_size >= RtsFlags.GcFlags.maxStkSize) {
         // #3677: In a stack overflow situation, stack squeezing may
         // reduce the stack size, but we don't know whether it has been
         // reduced enough for the stack check to succeed if we try
@@ -514,6 +535,9 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
         // happened, then we try running the thread again.  The
         // TSO_SQUEEZED flag is set by threadPaused() to tell us whether
         // squeezing happened or not.
+        if (tso->flags & TSO_SQUEEZED) {
+            return;
+        }
 
         debugTrace(DEBUG_gc,
                    "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",
@@ -525,48 +549,80 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
                                  stg_min(tso->stackobj->stack + tso->stackobj->stack_size,
                                          tso->stackobj->sp+64)));
 
-        // Send this thread the StackOverflow exception
-        throwToSingleThreaded(cap, tso, (StgClosure *)stackOverflow_closure);
+        // Note [Throw to self when masked], also #767 and #8303.
+        throwToSelf(cap, tso, (StgClosure *)stackOverflow_closure);
+        return;
     }
 
 
     // We also want to avoid enlarging the stack if squeezing has
     // already released some of it.  However, we don't want to get into
-    // a pathalogical situation where a thread has a nearly full stack
+    // a pathological situation where a thread has a nearly full stack
     // (near its current limit, but not near the absolute -K limit),
     // keeps allocating a little bit, squeezing removes a little bit,
     // and then it runs again.  So to avoid this, if we squeezed *and*
     // there is still less than BLOCK_SIZE_W words free, then we enlarge
     // the stack anyway.
-    if ((tso->flags & TSO_SQUEEZED) && 
+    //
+    // NB: This reasoning only applies if the stack has been squeezed;
+    // if no squeezing has occurred, then BLOCK_SIZE_W free space does
+    // not mean there is enough stack to run; the thread may have
+    // requested a large amount of stack (see below).  If the amount
+    // we squeezed is not enough to run the thread, we'll come back
+    // here (no squeezing will have occurred and thus we'll enlarge the
+    // stack.)
+    if ((tso->flags & TSO_SQUEEZED) &&
         ((W_)(tso->stackobj->sp - tso->stackobj->stack) >= BLOCK_SIZE_W)) {
         return;
     }
 
+    old_stack = tso->stackobj;
+
+    // If we used less than half of the previous stack chunk, then we
+    // must have failed a stack check for a large amount of stack.  In
+    // this case we allocate a double-sized chunk to try to
+    // accommodate the large stack request.  If that also fails, the
+    // next chunk will be 4x normal size, and so on.
+    //
+    // It would be better to have the mutator tell us how much stack
+    // was needed, as we do with heap allocations, but this works for
+    // now.
+    //
+    if (old_stack->sp > old_stack->stack + old_stack->stack_size / 2)
+    {
+        chunk_size = stg_max(2 * (old_stack->stack_size + sizeofW(StgStack)),
+                             RtsFlags.GcFlags.stkChunkSize);
+    }
+    else
+    {
+        chunk_size = RtsFlags.GcFlags.stkChunkSize;
+    }
+
     debugTraceCap(DEBUG_sched, cap,
                   "allocating new stack chunk of size %d bytes",
-                  RtsFlags.GcFlags.stkChunkSize * sizeof(W_));
+                  chunk_size * sizeof(W_));
 
-    old_stack = tso->stackobj;
+    // Charge the current thread for allocating stack.  Stack usage is
+    // non-deterministic, because the chunk boundaries might vary from
+    // run to run, but accounting for this is better than not
+    // accounting for it, since a deep recursion will otherwise not be
+    // subject to allocation limits.
+    cap->r.rCurrentTSO = tso;
+    new_stack = (StgStack*) allocate(cap, chunk_size);
+    cap->r.rCurrentTSO = NULL;
 
-    new_stack = (StgStack*) allocate(cap, RtsFlags.GcFlags.stkChunkSize);
-    SET_HDR(new_stack, &stg_STACK_info, CCS_SYSTEM);
-    TICK_ALLOC_STACK(RtsFlags.GcFlags.stkChunkSize);
+    SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs);
+    TICK_ALLOC_STACK(chunk_size);
 
     new_stack->dirty = 0; // begin clean, we'll mark it dirty below
-    new_stack->stack_size = RtsFlags.GcFlags.stkChunkSize - sizeofW(StgStack);
+    new_stack->stack_size = chunk_size - sizeofW(StgStack);
     new_stack->sp = new_stack->stack + new_stack->stack_size;
 
     tso->tot_stack_size += new_stack->stack_size;
 
-    new_stack->sp -= sizeofW(StgUnderflowFrame);
-    frame = (StgUnderflowFrame*)new_stack->sp;
-    frame->info = &stg_stack_underflow_frame_info;
-    frame->next_chunk  = old_stack;
-
     {
         StgWord *sp;
-        nat chunk_words, size;
+        W_ chunk_words, size;
 
         // find the boundary of the chunk of old stack we're going to
         // copy to the new stack.  We skip over stack frames until we
@@ -591,6 +647,28 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
             sp += size;
         }
 
+        if (sp == old_stack->stack + old_stack->stack_size) {
+            //
+            // the old stack chunk is now empty, so we do *not* insert
+            // an underflow frame pointing back to it.  There are two
+            // cases: either the old stack chunk was the last one, in
+            // which case it ends with a STOP_FRAME, or it is not the
+            // last one, and it already ends with an UNDERFLOW_FRAME
+            // pointing to the previous chunk.  In the latter case, we
+            // will copy the UNDERFLOW_FRAME into the new stack chunk.
+            // In both cases, the old chunk will be subsequently GC'd.
+            //
+            // With the default settings, -ki1k -kb1k, this means the
+            // first stack chunk will be discarded after the first
+            // overflow, being replaced by a non-moving 32k chunk.
+            //
+        } else {
+            new_stack->sp -= sizeofW(StgUnderflowFrame);
+            frame = (StgUnderflowFrame*)new_stack->sp;
+            frame->info = &stg_stack_underflow_frame_info;
+            frame->next_chunk  = old_stack;
+        }
+
         // copy the stack chunk between tso->sp and sp to
         //   new_tso->sp + (tso->sp - sp)
         chunk_words = sp - old_stack->sp;
@@ -603,14 +681,6 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
         new_stack->sp -= chunk_words;
     }
 
-    // if the old stack chunk is now empty, discard it.  With the
-    // default settings, -ki1k -kb1k, this means the first stack chunk
-    // will be discarded after the first overflow, being replaced by a
-    // non-moving 32k chunk.
-    if (old_stack->sp == old_stack->stack + old_stack->stack_size) {
-        frame->next_chunk = new_stack;
-    }
-
     tso->stackobj = new_stack;
 
     // we're about to run it, better mark it dirty
@@ -621,16 +691,17 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
 }
 
 
+
 /* ---------------------------------------------------------------------------
    Stack underflow - called from the stg_stack_underflow_info frame
    ------------------------------------------------------------------------ */
 
-nat // returns offset to the return address
+W_ // returns offset to the return address
 threadStackUnderflow (Capability *cap, StgTSO *tso)
 {
     StgStack *new_stack, *old_stack;
     StgUnderflowFrame *frame;
-    nat retvals;
+    uint32_t retvals;
 
     debugTraceCap(DEBUG_sched, cap, "stack underflow");
 
@@ -647,7 +718,7 @@ threadStackUnderflow (Capability *cap, StgTSO *tso)
     if (retvals != 0)
     {
         // we have some return values to copy to the old stack
-        if ((new_stack->sp - new_stack->stack) < retvals)
+        if ((W_)(new_stack->sp - new_stack->stack) < retvals)
         {
             barf("threadStackUnderflow: not enough space for return values");
         }
@@ -673,6 +744,85 @@ threadStackUnderflow (Capability *cap, StgTSO *tso)
 }
 
 /* ----------------------------------------------------------------------------
+   Implementation of tryPutMVar#
+
+   NOTE: this should be kept in sync with stg_tryPutMVarzh in PrimOps.cmm
+   ------------------------------------------------------------------------- */
+
+bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value)
+{
+    const StgInfoTable *info;
+    StgMVarTSOQueue *q;
+    StgTSO *tso;
+
+    info = lockClosure((StgClosure*)mvar);
+
+    if (mvar->value != &stg_END_TSO_QUEUE_closure) {
+#if defined(THREADED_RTS)
+        unlockClosure((StgClosure*)mvar, info);
+#endif
+        return false;
+    }
+
+    q = mvar->head;
+loop:
+    if (q == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) {
+        /* No further takes, the MVar is now full. */
+        if (info == &stg_MVAR_CLEAN_info) {
+            dirty_MVAR(&cap->r, (StgClosure*)mvar);
+        }
+
+        mvar->value = value;
+        unlockClosure((StgClosure*)mvar, &stg_MVAR_DIRTY_info);
+        return true;
+    }
+    if (q->header.info == &stg_IND_info ||
+        q->header.info == &stg_MSG_NULL_info) {
+        q = (StgMVarTSOQueue*)((StgInd*)q)->indirectee;
+        goto loop;
+    }
+
+    // There are takeMVar(s) waiting: wake up the first one
+    tso = q->tso;
+    mvar->head = q->link;
+    if (mvar->head == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) {
+        mvar->tail = (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure;
+    }
+
+    ASSERT(tso->block_info.closure == (StgClosure*)mvar);
+    // save why_blocked here, because waking up the thread destroys
+    // this information
+    StgWord why_blocked = tso->why_blocked;
+
+    // actually perform the takeMVar
+    StgStack* stack = tso->stackobj;
+    stack->sp[1] = (W_)value;
+    stack->sp[0] = (W_)&stg_ret_p_info;
+
+    // indicate that the MVar operation has now completed.
+    tso->_link = (StgTSO*)&stg_END_TSO_QUEUE_closure;
+
+    if (stack->dirty == 0) {
+        dirty_STACK(cap, stack);
+    }
+
+    tryWakeupThread(cap, tso);
+
+    // If it was an readMVar, then we can still do work,
+    // so loop back. (XXX: This could take a while)
+    if (why_blocked == BlockedOnMVarRead) {
+        q = ((StgMVarTSOQueue*)q)->link;
+        goto loop;
+    }
+
+    ASSERT(why_blocked == BlockedOnMVar);
+
+    unlockClosure((StgClosure*)mvar, info);
+
+    return true;
+}
+
+/* ----------------------------------------------------------------------------
  * Debugging: why is a thread blocked
  * ------------------------------------------------------------------------- */
 
@@ -681,25 +831,30 @@ void
 printThreadBlockage(StgTSO *tso)
 {
   switch (tso->why_blocked) {
+#if defined(mingw32_HOST_OS)
+    case BlockedOnDoProc:
+    debugBelch("is blocked on proc (request: %u)", tso->block_info.async_result->reqID);
+    break;
+#endif
+#if !defined(THREADED_RTS)
   case BlockedOnRead:
     debugBelch("is blocked on read from fd %d", (int)(tso->block_info.fd));
     break;
   case BlockedOnWrite:
     debugBelch("is blocked on write to fd %d", (int)(tso->block_info.fd));
     break;
-#if defined(mingw32_HOST_OS)
-    case BlockedOnDoProc:
-    debugBelch("is blocked on proc (request: %u)", tso->block_info.async_result->reqID);
-    break;
-#endif
   case BlockedOnDelay:
     debugBelch("is blocked until %ld", (long)(tso->block_info.target));
     break;
+#endif
   case BlockedOnMVar:
     debugBelch("is blocked on an MVar @ %p", tso->block_info.closure);
     break;
+  case BlockedOnMVarRead:
+    debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.closure);
+    break;
   case BlockedOnBlackHole:
-      debugBelch("is blocked on a black hole %p", 
+      debugBelch("is blocked on a black hole %p",
                  ((StgBlockingQueue*)tso->block_info.bh->bh));
     break;
   case BlockedOnMsgThrowTo:
@@ -722,7 +877,7 @@ printThreadBlockage(StgTSO *tso)
     break;
   default:
     barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %d (%d)",
-        tso->why_blocked, tso->id, tso);
+         tso->why_blocked, tso->id, tso);
   }
 }
 
@@ -736,35 +891,35 @@ printThreadStatus(StgTSO *t)
       if (label) debugBelch("[\"%s\"] ",(char *)label);
     }
         switch (t->what_next) {
-       case ThreadKilled:
-           debugBelch("has been killed");
-           break;
-       case ThreadComplete:
-           debugBelch("has completed");
-           break;
-       default:
-           printThreadBlockage(t);
-       }
+        case ThreadKilled:
+            debugBelch("has been killed");
+            break;
+        case ThreadComplete:
+            debugBelch("has completed");
+            break;
+        default:
+            printThreadBlockage(t);
+        }
         if (t->dirty) {
             debugBelch(" (TSO_DIRTY)");
         }
-       debugBelch("\n");
+        debugBelch("\n");
 }
 
 void
 printAllThreads(void)
 {
   StgTSO *t, *next;
-  nat i, g;
+  uint32_t i, g;
   Capability *cap;
 
   debugBelch("all threads:\n");
 
   for (i = 0; i < n_capabilities; i++) {
-      cap = &capabilities[i];
+      cap = capabilities[i];
       debugBelch("threads on capability %d:\n", cap->no);
       for (t = cap->run_queue_hd; t != END_TSO_QUEUE; t = t->_link) {
-         printThreadStatus(t);
+          printThreadStatus(t);
       }
   }
 
@@ -772,7 +927,7 @@ printAllThreads(void)
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (t = generations[g].threads; t != END_TSO_QUEUE; t = next) {
       if (t->why_blocked != NotBlocked) {
-         printThreadStatus(t);
+          printThreadStatus(t);
       }
       next = t->global_link;
     }
@@ -780,13 +935,13 @@ printAllThreads(void)
 }
 
 // useful from gdb
-void 
+void
 printThreadQueue(StgTSO *t)
 {
-    nat i = 0;
+    uint32_t i = 0;
     for (; t != END_TSO_QUEUE; t = t->_link) {
-       printThreadStatus(t);
-       i++;
+        printThreadStatus(t);
+        i++;
     }
     debugBelch("%d threads on queue\n", i);
 }