summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--includes/rts/EventLogFormat.h13
-rw-r--r--rts/Messages.c43
-rw-r--r--rts/Messages.h1
-rw-r--r--rts/RtsProbes.d2
-rw-r--r--rts/Schedule.c14
-rw-r--r--rts/Trace.c43
-rw-r--r--rts/Trace.h23
-rw-r--r--rts/eventlog/EventLog.c12
-rw-r--r--rts/eventlog/EventLog.h5
9 files changed, 124 insertions, 32 deletions
diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 87010eea8a..5741ad9e06 100644
--- 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_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) */
@@ -138,6 +138,17 @@
* #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
diff --git a/rts/Messages.c b/rts/Messages.c
index 1730278930..5dec6c6927 100644
--- a/rts/Messages.c
+++ b/rts/Messages.c
@@ -303,3 +303,46 @@ loop:
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 febb839ee9..4121364b21 100644
--- a/rts/Messages.h
+++ b/rts/Messages.h
@@ -9,6 +9,7 @@
#include "BeginPrivate.h"
nat messageBlackHole(Capability *cap, MessageBlackHole *msg);
+StgTSO * blackHoleOwner (StgClosure *bh);
#ifdef THREADED_RTS
void executeMessage (Capability *cap, Message *m);
diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index 87a34c8dca..6312c43362 100644
--- 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);
- 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);
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 621aef2ab7..4343a149cc 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -484,7 +484,17 @@ run_thread:
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);
@@ -1724,7 +1734,7 @@ suspendThread (StgRegTable *reg, rtsBool interruptible)
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;
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
{
diff --git a/rts/Trace.h b/rts/Trace.h
index 27de60e4ed..620915665b 100644
--- 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)) { \
- 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,
- 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 */
+#define traceSchedEvent2(cap, tag, tso, other, info) /* 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)
-#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) \
@@ -225,7 +231,7 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
#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 */
@@ -278,11 +284,12 @@ INLINE_HEADER void traceEventRunThread(Capability *cap 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,
- (EventThreadStatus)status);
+ (EventThreadStatus)status, (EventThreadID)info);
}
// 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 fec34b9647..a77c257e1b 100644
--- 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 =
- sizeof(EventThreadID) + sizeof(StgWord16);
+ sizeof(EventThreadID) + sizeof(StgWord16) + sizeof(EventThreadID);
break;
case EVENT_STARTUP: // (cap count)
@@ -382,7 +382,8 @@ void
postSchedEvent (Capability *cap,
EventTypeNum tag,
StgThreadID thread,
- StgWord64 other)
+ StgWord info1,
+ StgWord info2)
{
EventsBuf *eb;
@@ -407,7 +408,7 @@ postSchedEvent (Capability *cap,
case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
{
- postThreadID(eb,other /* spark_thread */);
+ postThreadID(eb,info1 /* spark_thread */);
break;
}
@@ -416,14 +417,15 @@ postSchedEvent (Capability *cap,
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);
- postWord16(eb,other /* status */);
+ postWord16(eb,info1 /* status */);
+ postThreadID(eb,info2 /* blocked on thread */);
break;
}
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index 7dc249d35d..0cfab5c091 100644
--- 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,
- StgThreadID id, StgWord64 other);
+ StgThreadID id, StgWord info1, StgWord info2);
/*
* 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,
- StgWord64 other STG_UNUSED)
+ StgWord info1 STG_UNUSED,
+ StgWord info2 STG_UNUSED)
{ /* nothing */ }
INLINE_HEADER void postEvent (Capability *cap STG_UNUSED,
View Lorry Controller Status