rts: Clear block_info when unblockingwip/clear-block-info

Otherwise we may end up with dangling pointers which may complicate
debugging. Also, introduce more strict checking of block_info in
checkTSO.

7 files changed, 51 insertions, 13 deletions

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index f727383082..337eb2620f 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -729,6 +729,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 
  done:
   tso->why_blocked = NotBlocked;
+  tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
   appendToRunQueue(cap, tso);
 }
 
@@ -1092,6 +1093,7 @@ done:
     // wake it up
     if (tso->why_blocked != NotBlocked) {
         tso->why_blocked = NotBlocked;
+        tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
         appendToRunQueue(cap,tso);
     }
 
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 685862a08b..0cd0ff2876 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2565,7 +2565,8 @@ resumeThread (void *task_)
     traceEventRunThread(cap, tso);
 
     /* Reset blocking status */
-    tso->why_blocked  = NotBlocked;
+    tso->why_blocked = NotBlocked;
+    tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
 
     if ((tso->flags & TSO_BLOCKEX) == 0) {
         // avoid locking the TSO if we don't have to
diff --git a/rts/Threads.c b/rts/Threads.c
index b36b4ddb81..5a4660f718 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -334,6 +334,7 @@ unblock:
     // just run the thread now, if the BH is not really available,
     // we'll block again.
     tso->why_blocked = NotBlocked;
+    tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
     appendToRunQueue(cap,tso);
 
     // We used to set the context switch flag here, which would
diff --git a/rts/include/rts/storage/TSO.h b/rts/include/rts/storage/TSO.h
index 4ca19853d7..cdaa3f04e3 100644
--- a/rts/include/rts/storage/TSO.h
+++ b/rts/include/rts/storage/TSO.h
@@ -289,8 +289,8 @@ void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target);
 void dirty_STACK (Capability *cap, StgStack *stack);
 
 /* -----------------------------------------------------------------------------
-   Invariants:
-
+   Note [TSO invariants]
+   ~~~~~~~~~~~~~~~~~~~~~
    An active thread has the following properties:
 
       tso->stack < tso->sp < tso->stack+tso->stack_size
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index 89a46fd763..ccbe9c4f24 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now)
         }
         iomgr->sleeping_queue = tso->_link;
         tso->why_blocked = NotBlocked;
+        tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
         tso->_link = END_TSO_QUEUE;
         IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %"
                                        FMT_StgThreadID "\n", tso->id));
@@ -437,6 +438,7 @@ awaitEvent(Capability *cap, bool wait)
                       debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n",
                                  tso->id));
                   tso->why_blocked = NotBlocked;
+                  tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
                   tso->_link = END_TSO_QUEUE;
                   pushOnRunQueue(cap,tso);
                   break;
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index fa497251e2..c0f5a6da19 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -737,6 +737,7 @@ checkSTACK (StgStack *stack)
     checkStackChunk(sp, stack_end);
 }
 
+/* See Note [TSO invariants] in TSO.h */
 void
 checkTSO(StgTSO *tso)
 {
@@ -750,13 +751,42 @@ checkTSO(StgTSO *tso)
            info == &stg_WHITEHOLE_info); // used to happen due to STM doing
                                          // lockTSO(), might not happen now
 
-    if (   tso->why_blocked == BlockedOnMVar
-        || tso->why_blocked == BlockedOnMVarRead
-        || tso->why_blocked == BlockedOnBlackHole
-        || tso->why_blocked == BlockedOnMsgThrowTo
-        || tso->why_blocked == NotBlocked
-        ) {
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
+    switch (tso->why_blocked) {
+        case NotBlocked:
+            ASSERT(tso->block_info.closure == (StgClosure*) END_TSO_QUEUE);
+            break;
+        case BlockedOnMVar:
+        case BlockedOnMVarRead:
+            ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
+            ASSERT(get_itbl(tso->block_info.closure) == MVAR_CLEAN
+                    || get_itbl(tso->block_info.closure) == MVAR_DIRTY);
+            break;
+        case BlockedOnBlackHole:
+            ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
+            ASSERT(get_itbl(tso->block_info.closure) == &stg_MSG_BLACKHOLE_info);
+            break;
+        case BlockedOnRead:
+        case BlockedOnWrite:
+        case BlockedOnDelay:
+        case BlockedOnDoProc:
+            ASSERT(tso->block_info.closure == NULL);
+            break;
+        case BlockedOnSTM:
+            ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
+            ASSERT(tso->block_info.closure == (StgClosure*) END_TSO_QUEUE
+                    || get_itbl(tso->block_info.closure) == STM_AWOKEN);
+            break;
+        case BlockedOnCCall:
+        case BlockedOnCCall_Interruptible:
+            break;
+        case BlockedOnMsgThrowTo:
+            ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure));
+            ASSERT(get_itbl(tso->block_info.closure) == &stg_MSG_THROWTO_info);
+            break;
+        case ThreadMigrating:
+            break;
+        default:
+            barf("checkTSO: Invalid why_blocked %x", tso->why_blocked);
     }
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq));
diff --git a/rts/win32/AsyncMIO.c b/rts/win32/AsyncMIO.c
index 00d1638d63..6230512eeb 100644
--- a/rts/win32/AsyncMIO.c
+++ b/rts/win32/AsyncMIO.c
@@ -318,14 +318,16 @@ start:
                                                            : END_TSO_QUEUE;
                         }
 
-                        // Terminates the run queue + this inner for-loop.
-                        tso->_link = END_TSO_QUEUE;
-                        tso->why_blocked = NotBlocked;
                         // save the StgAsyncIOResult in the
                         // stg_block_async_info stack frame, because
                         // the block_info field will be overwritten by
                         // pushOnRunQueue().
                         tso->stackobj->sp[1] = (W_)tso->block_info.async_result;
+
+                        tso->why_blocked = NotBlocked;
+                        tso->block_info.closure = (StgClosure *)END_TSO_QUEUE;
+                        // Terminates the run queue + this inner for-loop.
+                        tso->_link = END_TSO_QUEUE;
                         pushOnRunQueue(&MainCapability, tso);
                         break;
                     }