[Git][ghc/ghc][wip/clear-block-info] rts: Clear block_info when unblocking

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Tue May 16 12:08:03 UTC 2023



Ben Gamari pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC


Commits:
c8f74d5f by Ben Gamari at 2023-05-16T08:07:57-04:00
rts: Clear block_info when unblocking

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

- - - - -


7 changed files:

- rts/RaiseAsync.c
- rts/Schedule.c
- rts/Threads.c
- rts/include/rts/storage/TSO.h
- rts/posix/Select.c
- rts/sm/Sanity.c
- rts/win32/AsyncMIO.c


Changes:

=====================================
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);
     }
 


=====================================
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


=====================================
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


=====================================
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


=====================================
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;


=====================================
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));


=====================================
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;
                     }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8f74d5f6e9874424c1e55f586ff44568308a94c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8f74d5f6e9874424c1e55f586ff44568308a94c
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230516/da582c4e/attachment-0001.html>


More information about the ghc-commits mailing list