Annotate thread stop events with the owner of the black hole

So we can now get these in ThreadScope:

  19487000: cap 1: stopping thread 6 (blocked on black hole owned by thread 4)

Note: needs an update to ghc-events.  Older ThreadScopes will just
ignore the new information.

1 files changed, 30 insertions, 13 deletions

diff --git a/rts/Trace.c b/rts/Trace.c
index 53fc25a249..f2f9e81549 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -137,14 +137,26 @@ static char *thread_stop_reasons[] = {
     [ThreadYielding] = "yielding",
     [ThreadBlocked] = "blocked",
     [ThreadFinished] = "finished",
-    [THREAD_SUSPENDED_FOREIGN_CALL] = "suspended while making a foreign call"
+    [THREAD_SUSPENDED_FOREIGN_CALL] = "suspended while making a foreign call",
+    [6 + BlockedOnMVar]         = "blocked on an MVar",
+    [6 + BlockedOnBlackHole]    = "blocked on a black hole",
+    [6 + BlockedOnRead]         = "blocked on a read operation",
+    [6 + BlockedOnWrite]        = "blocked on a write operation",
+    [6 + BlockedOnDelay]        = "blocked on a delay operation",
+    [6 + BlockedOnSTM]          = "blocked on STM",
+    [6 + BlockedOnDoProc]       = "blocked on asyncDoProc",
+    [6 + BlockedOnCCall]        = "blocked on a foreign call",
+    [6 + BlockedOnCCall_Interruptible] = "blocked on a foreign call (interruptible)",
+    [6 + BlockedOnMsgThrowTo]   =  "blocked on throwTo",
+    [6 + ThreadMigrating]       =  "migrating"
 };
 #endif
 
 #ifdef DEBUG
 static void traceSchedEvent_stderr (Capability *cap, EventTypeNum tag, 
                                     StgTSO *tso, 
-                                    StgWord64 other STG_UNUSED)
+                                    StgWord info1 STG_UNUSED,
+                                    StgWord info2 STG_UNUSED)
 {
     ACQUIRE_LOCK(&trace_utx);
 
@@ -168,24 +180,29 @@ static void traceSchedEvent_stderr (Capability *cap, EventTypeNum tag,
         break;
     case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
         debugBelch("cap %d: creating spark thread %lu\n", 
-                   cap->no, (long)other);
+                   cap->no, (long)info1);
         break;
     case EVENT_MIGRATE_THREAD:  // (cap, thread, new_cap)
         debugBelch("cap %d: thread %lu migrating to cap %d\n", 
-                   cap->no, (lnat)tso->id, (int)other);
+                   cap->no, (lnat)tso->id, (int)info1);
         break;
     case EVENT_STEAL_SPARK:     // (cap, thread, victim_cap)
         debugBelch("cap %d: thread %lu stealing a spark from cap %d\n", 
-                   cap->no, (lnat)tso->id, (int)other);
+                   cap->no, (lnat)tso->id, (int)info1);
         break;
-    case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
+    case EVENT_THREAD_WAKEUP:   // (cap, thread, info1_cap)
         debugBelch("cap %d: waking up thread %lu on cap %d\n", 
-                   cap->no, (lnat)tso->id, (int)other);
+                   cap->no, (lnat)tso->id, (int)info1);
         break;
         
     case EVENT_STOP_THREAD:     // (cap, thread, status)
-        debugBelch("cap %d: thread %lu stopped (%s)\n", 
-                   cap->no, (lnat)tso->id, thread_stop_reasons[other]);
+        if (info1 == 6 + BlockedOnBlackHole) {
+            debugBelch("cap %d: thread %lu stopped (blocked on black hole owned by thread %lu)\n",
+                       cap->no, (lnat)tso->id, (long)info2);
+        } else {
+            debugBelch("cap %d: thread %lu stopped (%s)\n",
+                       cap->no, (lnat)tso->id, thread_stop_reasons[info1]);
+        }
         break;
     case EVENT_SHUTDOWN:        // (cap)
         debugBelch("cap %d: shutting down\n", cap->no);
@@ -222,15 +239,15 @@ static void traceSchedEvent_stderr (Capability *cap, EventTypeNum tag,
 #endif
 
 void traceSchedEvent_ (Capability *cap, EventTypeNum tag, 
-                      StgTSO *tso, StgWord64 other)
+                       StgTSO *tso, StgWord info1, StgWord info2)
 {
 #ifdef DEBUG
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
-        traceSchedEvent_stderr(cap, tag, tso, other);
+        traceSchedEvent_stderr(cap, tag, tso, info1, info2);
     } else
 #endif
     {
-        postSchedEvent(cap,tag,tso ? tso->id : 0,other);
+        postSchedEvent(cap,tag,tso ? tso->id : 0, info1, info2);
     }
 }
 
@@ -238,7 +255,7 @@ void traceEvent_ (Capability *cap, EventTypeNum tag)
 {
 #ifdef DEBUG
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
-        traceSchedEvent_stderr(cap, tag, 0, 0);
+        traceSchedEvent_stderr(cap, tag, 0, 0, 0);
     } else
 #endif
     {