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.

diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 87010ee..5741ad9 100644 (file)
--- a/includes/rts/EventLogFormat.h
+++ b/includes/rts/EventLogFormat.h
@@ -101,7 +101,7 @@
  */
 #define EVENT_CREATE_THREAD        0 /* (thread)               */
 #define EVENT_RUN_THREAD           1 /* (thread)               */
  */
 #define EVENT_CREATE_THREAD        0 /* (thread)               */
 #define EVENT_RUN_THREAD           1 /* (thread)               */

-#define EVENT_STOP_THREAD          2 /* (thread, status)       */
+#define EVENT_STOP_THREAD          2 /* (thread, status, blockinfo) */

 #define EVENT_THREAD_RUNNABLE      3 /* (thread)               */
 #define EVENT_MIGRATE_THREAD       4 /* (thread, new_cap)      */
 #define EVENT_RUN_SPARK            5 /* (thread)               */
 #define EVENT_THREAD_RUNNABLE      3 /* (thread)               */
 #define EVENT_MIGRATE_THREAD       4 /* (thread, new_cap)      */
 #define EVENT_RUN_SPARK            5 /* (thread)               */

@@ -138,6 +138,17 @@
  * #define ThreadYielding 3
  * #define ThreadBlocked  4
  * #define ThreadFinished 5
  * #define ThreadYielding 3
  * #define ThreadBlocked  4
  * #define ThreadFinished 5

+ * #define ForeignCall                  6
+ * #define BlockedOnMVar                7
+ * #define BlockedOnBlackHole           8
+ * #define BlockedOnRead                9
+ * #define BlockedOnWrite               10
+ * #define BlockedOnDelay               11
+ * #define BlockedOnSTM                 12
+ * #define BlockedOnDoProc              13
+ * #define BlockedOnCCall               -- not used (see ForeignCall)
+ * #define BlockedOnCCall_NoUnblockExc  -- not used (see ForeignCall)
+ * #define BlockedOnMsgThrowTo          16

  */
 #define THREAD_SUSPENDED_FOREIGN_CALL 6
 
  */
 #define THREAD_SUSPENDED_FOREIGN_CALL 6
 

diff --git a/rts/Messages.c b/rts/Messages.c
index 1730278..5dec6c6 100644 (file)
--- a/rts/Messages.c
+++ b/rts/Messages.c
@@ -303,3 +303,46 @@ loop:
     return 0; // not blocked
 }
 
     return 0; // not blocked
 }
 

+// A shorter version of messageBlackHole(), that just returns the
+// owner (or NULL if the owner cannot be found, because the blackhole
+// has been updated in the meantime).
+
+StgTSO * blackHoleOwner (StgClosure *bh)
+{
+    const StgInfoTable *info;
+    StgClosure *p;
+
+    info = bh->header.info;
+
+    if (info != &stg_BLACKHOLE_info &&
+        info != &stg_CAF_BLACKHOLE_info && 
+        info != &__stg_EAGER_BLACKHOLE_info &&
+        info != &stg_WHITEHOLE_info) {
+        return NULL;
+    }
+
+    // The blackhole must indirect to a TSO, a BLOCKING_QUEUE, an IND,
+    // or a value.
+loop:
+    // NB. VOLATILE_LOAD(), because otherwise gcc hoists the load
+    // and turns this into an infinite loop.
+    p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee));
+    info = p->header.info;
+
+    if (info == &stg_IND_info) goto loop;
+
+    else if (info == &stg_TSO_info)
+    {
+        return (StgTSO*)p;
+    }
+    else if (info == &stg_BLOCKING_QUEUE_CLEAN_info || 
+             info == &stg_BLOCKING_QUEUE_DIRTY_info)
+    {
+        StgBlockingQueue *bq = (StgBlockingQueue *)p;
+        return bq->owner;
+    }
+    
+    return NULL; // not blocked
+}
+
+

diff --git a/rts/Messages.h b/rts/Messages.h
index febb839..4121364 100644 (file)
--- a/rts/Messages.h
+++ b/rts/Messages.h
@@ -9,6 +9,7 @@
 #include "BeginPrivate.h"
 
 nat messageBlackHole(Capability *cap, MessageBlackHole *msg);
 #include "BeginPrivate.h"
 
 nat messageBlackHole(Capability *cap, MessageBlackHole *msg);

+StgTSO * blackHoleOwner (StgClosure *bh);

 
 #ifdef THREADED_RTS
 void executeMessage (Capability *cap, Message *m);
 
 #ifdef THREADED_RTS
 void executeMessage (Capability *cap, Message *m);

diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index 87a34c8..6312c43 100644 (file)
--- a/rts/RtsProbes.d
+++ b/rts/RtsProbes.d
@@ -36,7 +36,7 @@ provider HaskellEvent {
   // scheduler events
   probe create__thread (EventCapNo, EventThreadID);
   probe run__thread (EventCapNo, EventThreadID);
   // scheduler events
   probe create__thread (EventCapNo, EventThreadID);
   probe run__thread (EventCapNo, EventThreadID);

-  probe stop__thread (EventCapNo, EventThreadID, EventThreadStatus);
+  probe stop__thread (EventCapNo, EventThreadID, EventThreadStatus, EventThreadID);

   probe thread__runnable (EventCapNo, EventThreadID);
   probe migrate__thread (EventCapNo, EventThreadID, EventCapNo);
   probe run__spark (EventCapNo, EventThreadID);
   probe thread__runnable (EventCapNo, EventThreadID);
   probe migrate__thread (EventCapNo, EventThreadID, EventCapNo);
   probe run__spark (EventCapNo, EventThreadID);

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 621aef2..4343a14 100644 (file)
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -484,7 +484,17 @@ run_thread:
     t->saved_winerror = GetLastError();
 #endif
 
     t->saved_winerror = GetLastError();
 #endif
 

-    traceEventStopThread(cap, t, ret);
+    if (ret == ThreadBlocked) {
+        if (t->why_blocked == BlockedOnBlackHole) {
+            StgTSO *owner = blackHoleOwner(t->block_info.bh->bh);
+            traceEventStopThread(cap, t, t->why_blocked + 6,
+                                 owner != NULL ? owner->id : 0);
+        } else {
+            traceEventStopThread(cap, t, t->why_blocked + 6, 0);
+        }
+    } else {
+        traceEventStopThread(cap, t, ret, 0);
+    }

 
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
     ASSERT(t->cap == cap);
 
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
     ASSERT(t->cap == cap);

@@ -1724,7 +1734,7 @@ suspendThread (StgRegTable *reg, rtsBool interruptible)
   task = cap->running_task;
   tso = cap->r.rCurrentTSO;
 
   task = cap->running_task;
   tso = cap->r.rCurrentTSO;
 

-  traceEventStopThread(cap, tso, THREAD_SUSPENDED_FOREIGN_CALL);
+  traceEventStopThread(cap, tso, THREAD_SUSPENDED_FOREIGN_CALL, 0);

 
   // XXX this might not be necessary --SDM
   tso->what_next = ThreadRunGHC;
 
   // XXX this might not be necessary --SDM
   tso->what_next = ThreadRunGHC;

diff --git a/rts/Trace.c b/rts/Trace.c
index 53fc25a..f2f9e81 100644 (file)
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -137,14 +137,26 @@ static char *thread_stop_reasons[] = {
     [ThreadYielding] = "yielding",
     [ThreadBlocked] = "blocked",
     [ThreadFinished] = "finished",
     [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, 
 };
 #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);
 
 {
     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", 
         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", 
         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", 
         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;
         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", 
         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)
         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);
         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, 
 #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) {
 {
 #ifdef DEBUG
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {

-        traceSchedEvent_stderr(cap, tag, tso, other);
+        traceSchedEvent_stderr(cap, tag, tso, info1, info2);

     } else
 #endif
     {
     } 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) {
 {
 #ifdef DEBUG
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {

-        traceSchedEvent_stderr(cap, tag, 0, 0);
+        traceSchedEvent_stderr(cap, tag, 0, 0, 0);

     } else
 #endif
     {
     } else
 #endif
     {

diff --git a/rts/Trace.h b/rts/Trace.h
index 27de60e..6209156 100644 (file)
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -78,11 +78,16 @@ void traceEnd (void);
  */
 #define traceSchedEvent(cap, tag, tso, other)   \
     if (RTS_UNLIKELY(TRACE_sched)) {            \
  */
 #define traceSchedEvent(cap, tag, tso, other)   \
     if (RTS_UNLIKELY(TRACE_sched)) {            \

-        traceSchedEvent_(cap, tag, tso, other); \
+        traceSchedEvent_(cap, tag, tso, other, 0); \
+    }
+
+#define traceSchedEvent2(cap, tag, tso, info1, info2) \
+    if (RTS_UNLIKELY(TRACE_sched)) {            \
+        traceSchedEvent_(cap, tag, tso, info1, info2); \

     }
 
 void traceSchedEvent_ (Capability *cap, EventTypeNum tag, 
     }
 
 void traceSchedEvent_ (Capability *cap, EventTypeNum tag, 

-                       StgTSO *tso, StgWord64 other);
+                       StgTSO *tso, StgWord info1, StgWord info2);

 
 
 /*
 
 
 /*

@@ -158,6 +163,7 @@ void traceThreadStatus_ (StgTSO *tso);
 #else /* !TRACING */
 
 #define traceSchedEvent(cap, tag, tso, other) /* nothing */
 #else /* !TRACING */
 
 #define traceSchedEvent(cap, tag, tso, other) /* nothing */

+#define traceSchedEvent2(cap, tag, tso, other, info) /* nothing */

 #define traceEvent(cap, tag) /* nothing */
 #define traceCap(class, cap, msg, ...) /* nothing */
 #define trace(class, msg, ...) /* nothing */
 #define traceEvent(cap, tag) /* nothing */
 #define traceCap(class, cap, msg, ...) /* nothing */
 #define trace(class, msg, ...) /* nothing */

@@ -186,8 +192,8 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
     HASKELLEVENT_CREATE_THREAD(cap, tid)
 #define dtraceRunThread(cap, tid)                       \
     HASKELLEVENT_RUN_THREAD(cap, tid)
     HASKELLEVENT_CREATE_THREAD(cap, tid)
 #define dtraceRunThread(cap, tid)                       \
     HASKELLEVENT_RUN_THREAD(cap, tid)

-#define dtraceStopThread(cap, tid, status)              \
-    HASKELLEVENT_STOP_THREAD(cap, tid, status)
+#define dtraceStopThread(cap, tid, status, info)        \
+    HASKELLEVENT_STOP_THREAD(cap, tid, status, info)

 #define dtraceThreadRunnable(cap, tid)                  \
     HASKELLEVENT_THREAD_RUNNABLE(cap, tid)
 #define dtraceMigrateThread(cap, tid, new_cap)          \
 #define dtraceThreadRunnable(cap, tid)                  \
     HASKELLEVENT_THREAD_RUNNABLE(cap, tid)
 #define dtraceMigrateThread(cap, tid, new_cap)          \

@@ -225,7 +231,7 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
 
 #define dtraceCreateThread(cap, tid)                    /* nothing */
 #define dtraceRunThread(cap, tid)                       /* nothing */
 
 #define dtraceCreateThread(cap, tid)                    /* nothing */
 #define dtraceRunThread(cap, tid)                       /* nothing */

-#define dtraceStopThread(cap, tid, status)              /* nothing */
+#define dtraceStopThread(cap, tid, status, info)        /* nothing */

 #define dtraceThreadRunnable(cap, tid)                  /* nothing */
 #define dtraceMigrateThread(cap, tid, new_cap)          /* nothing */
 #define dtraceRunSpark(cap, tid)                        /* nothing */
 #define dtraceThreadRunnable(cap, tid)                  /* nothing */
 #define dtraceMigrateThread(cap, tid, new_cap)          /* nothing */
 #define dtraceRunSpark(cap, tid)                        /* nothing */

@@ -278,11 +284,12 @@ INLINE_HEADER void traceEventRunThread(Capability *cap STG_UNUSED,
 
 INLINE_HEADER void traceEventStopThread(Capability          *cap    STG_UNUSED, 
                                         StgTSO              *tso    STG_UNUSED, 
 
 INLINE_HEADER void traceEventStopThread(Capability          *cap    STG_UNUSED, 
                                         StgTSO              *tso    STG_UNUSED, 

-                                        StgThreadReturnCode  status STG_UNUSED)
+                                        StgThreadReturnCode  status STG_UNUSED,
+                                        StgWord32           info    STG_UNUSED)

 {
 {

-    traceSchedEvent(cap, EVENT_STOP_THREAD, tso, status);
+    traceSchedEvent2(cap, EVENT_STOP_THREAD, tso, status, info);

     dtraceStopThread((EventCapNo)cap->no, (EventThreadID)tso->id,
     dtraceStopThread((EventCapNo)cap->no, (EventThreadID)tso->id,

-                     (EventThreadStatus)status);
+                     (EventThreadStatus)status, (EventThreadID)info);

 }
 
 // needs to be EXTERN_INLINE as it is used in another EXTERN_INLINE function
 }
 
 // needs to be EXTERN_INLINE as it is used in another EXTERN_INLINE function

diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index fec34b9..a77c257 100644 (file)
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -252,7 +252,7 @@ initEventLogging(void)
 
         case EVENT_STOP_THREAD:     // (cap, thread, status)
             eventTypes[t].size =
 
         case EVENT_STOP_THREAD:     // (cap, thread, status)
             eventTypes[t].size =

-                sizeof(EventThreadID) + sizeof(StgWord16);
+                sizeof(EventThreadID) + sizeof(StgWord16) + sizeof(EventThreadID);

             break;
 
         case EVENT_STARTUP:         // (cap count)
             break;
 
         case EVENT_STARTUP:         // (cap count)

@@ -382,7 +382,8 @@ void
 postSchedEvent (Capability *cap, 
                 EventTypeNum tag, 
                 StgThreadID thread, 
 postSchedEvent (Capability *cap, 
                 EventTypeNum tag, 
                 StgThreadID thread, 

-                StgWord64 other)
+                StgWord info1,
+                StgWord info2)

 {
     EventsBuf *eb;
 
 {
     EventsBuf *eb;
 

@@ -407,7 +408,7 @@ postSchedEvent (Capability *cap,
 
     case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
     {
 
     case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
     {

-        postThreadID(eb,other /* spark_thread */);
+        postThreadID(eb,info1 /* spark_thread */);

         break;
     }
 
         break;
     }
 

@@ -416,14 +417,15 @@ postSchedEvent (Capability *cap,
     case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
     {
         postThreadID(eb,thread);
     case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
     {
         postThreadID(eb,thread);

-        postCapNo(eb,other /* new_cap | victim_cap | other_cap */);
+        postCapNo(eb,info1 /* new_cap | victim_cap | other_cap */);

         break;
    }
 
     case EVENT_STOP_THREAD:     // (cap, thread, status)
     {
         postThreadID(eb,thread);
         break;
    }
 
     case EVENT_STOP_THREAD:     // (cap, thread, status)
     {
         postThreadID(eb,thread);

-        postWord16(eb,other /* status */);
+        postWord16(eb,info1 /* status */);
+        postThreadID(eb,info2 /* blocked on thread */);

         break;
     }
 
         break;
     }
 

diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index 7dc249d..0cfab5c 100644 (file)
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -32,7 +32,7 @@ void flushEventLog(void);     // event log inherited from parent
  * that has an associated thread).
  */
 void postSchedEvent(Capability *cap, EventTypeNum tag, 
  * that has an associated thread).
  */
 void postSchedEvent(Capability *cap, EventTypeNum tag, 

-                    StgThreadID id, StgWord64 other);
+                    StgThreadID id, StgWord info1, StgWord info2);

 
 /*
  * Post a nullary event.
 
 /*
  * Post a nullary event.

@@ -50,7 +50,8 @@ void postCapMsg(Capability *cap, char *msg, va_list ap);
 INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
                                    EventTypeNum tag STG_UNUSED,
                                    StgThreadID id   STG_UNUSED,
 INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
                                    EventTypeNum tag STG_UNUSED,
                                    StgThreadID id   STG_UNUSED,

-                                   StgWord64 other  STG_UNUSED)
+                                   StgWord info1    STG_UNUSED,
+                                   StgWord info2    STG_UNUSED)

 { /* nothing */ }
 
 INLINE_HEADER void postEvent (Capability *cap  STG_UNUSED,
 { /* nothing */ }
 
 INLINE_HEADER void postEvent (Capability *cap  STG_UNUSED,