From 784e214dd44eba39f4c34936a27e6cc82948205c Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 27 Jan 2011 16:42:26 +0000 Subject: [PATCH] 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. --- includes/rts/EventLogFormat.h | 13 ++++++++++++- rts/Messages.c | 43 +++++++++++++++++++++++++++++++++++++++++ rts/Messages.h | 1 + rts/RtsProbes.d | 2 +- rts/Schedule.c | 14 ++++++++++++-- rts/Trace.c | 43 ++++++++++++++++++++++++++++------------- rts/Trace.h | 23 ++++++++++++++-------- rts/eventlog/EventLog.c | 12 +++++++----- rts/eventlog/EventLog.h | 5 +++-- 9 files changed, 124 insertions(+), 32 deletions(-) diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h index 87010ee..5741ad9 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 1730278..5dec6c6 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 febb839..4121364 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 87a34c8..6312c43 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 621aef2..4343a14 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 53fc25a..f2f9e81 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 27de60e..6209156 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 fec34b9..a77c257 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 7dc249d..0cfab5c 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, -- 1.7.10.4