Merge branch 'master' of http://darcs.haskell.org/ghc
[ghc.git] / rts / Trace.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team 2006-2009
4 *
5 * Debug and performance tracing
6 *
7 * ---------------------------------------------------------------------------*/
8
9 // external headers
10 #include "Rts.h"
11
12 // internal headers
13 #include "Trace.h"
14
15 #ifdef TRACING
16
17 #include "GetTime.h"
18 #include "GetEnv.h"
19 #include "Stats.h"
20 #include "eventlog/EventLog.h"
21 #include "Threads.h"
22 #include "Printer.h"
23
24 #ifdef HAVE_UNISTD_H
25 #include <unistd.h>
26 #endif
27
28 #ifdef DEBUG
29 // debugging flags, set with +RTS -D<something>
30 int DEBUG_sched;
31 int DEBUG_interp;
32 int DEBUG_weak;
33 int DEBUG_gccafs;
34 int DEBUG_gc;
35 int DEBUG_block_alloc;
36 int DEBUG_sanity;
37 int DEBUG_stable;
38 int DEBUG_stm;
39 int DEBUG_prof;
40 int DEBUG_gran;
41 int DEBUG_par;
42 int DEBUG_linker;
43 int DEBUG_squeeze;
44 int DEBUG_hpc;
45 int DEBUG_sparks;
46 #endif
47
48 // events
49 int TRACE_sched;
50 int TRACE_gc;
51 int TRACE_spark_sampled;
52 int TRACE_spark_full;
53
54 #ifdef THREADED_RTS
55 static Mutex trace_utx;
56 #endif
57
58 static rtsBool eventlog_enabled;
59
60 /* ---------------------------------------------------------------------------
61 Starting up / shuttting down the tracing facilities
62 --------------------------------------------------------------------------- */
63
64 void initTracing (void)
65 {
66 #ifdef THREADED_RTS
67 initMutex(&trace_utx);
68 #endif
69
70 #ifdef DEBUG
71 #define DEBUG_FLAG(name, class) \
72 class = RtsFlags.DebugFlags.name ? 1 : 0;
73
74 DEBUG_FLAG(scheduler, DEBUG_sched);
75
76 DEBUG_FLAG(interpreter, DEBUG_interp);
77 DEBUG_FLAG(weak, DEBUG_weak);
78 DEBUG_FLAG(gccafs, DEBUG_gccafs);
79 DEBUG_FLAG(gc, DEBUG_gc);
80 DEBUG_FLAG(block_alloc, DEBUG_block_alloc);
81 DEBUG_FLAG(sanity, DEBUG_sanity);
82 DEBUG_FLAG(stable, DEBUG_stable);
83 DEBUG_FLAG(stm, DEBUG_stm);
84 DEBUG_FLAG(prof, DEBUG_prof);
85 DEBUG_FLAG(linker, DEBUG_linker);
86 DEBUG_FLAG(squeeze, DEBUG_squeeze);
87 DEBUG_FLAG(hpc, DEBUG_hpc);
88 DEBUG_FLAG(sparks, DEBUG_sparks);
89 #endif
90
91 // -Ds turns on scheduler tracing too
92 TRACE_sched =
93 RtsFlags.TraceFlags.scheduler ||
94 RtsFlags.DebugFlags.scheduler;
95
96 // -Dg turns on gc tracing too
97 TRACE_gc =
98 RtsFlags.TraceFlags.gc ||
99 RtsFlags.DebugFlags.gc;
100
101 TRACE_spark_sampled =
102 RtsFlags.TraceFlags.sparks_sampled;
103
104 // -Dr turns on full spark tracing
105 TRACE_spark_full =
106 RtsFlags.TraceFlags.sparks_full ||
107 RtsFlags.DebugFlags.sparks;
108
109 eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG;
110
111 /* Note: we can have TRACE_sched or TRACE_spark turned on even when
112 eventlog_enabled is off. In the DEBUG way we may be tracing to stderr.
113 */
114
115 if (eventlog_enabled) {
116 initEventLogging();
117 }
118 }
119
120 void endTracing (void)
121 {
122 if (eventlog_enabled) {
123 endEventLogging();
124 }
125 }
126
127 void freeTracing (void)
128 {
129 if (eventlog_enabled) {
130 freeEventLogging();
131 }
132 }
133
134 void resetTracing (void)
135 {
136 if (eventlog_enabled) {
137 abortEventLogging(); // abort eventlog inherited from parent
138 initEventLogging(); // child starts its own eventlog
139 }
140 }
141
142 /* ---------------------------------------------------------------------------
143 Emitting trace messages/events
144 --------------------------------------------------------------------------- */
145
146 #ifdef DEBUG
147 static void tracePreface (void)
148 {
149 #ifdef THREADED_RTS
150 debugBelch("%12lx: ", (unsigned long)osThreadId());
151 #endif
152 if (RtsFlags.TraceFlags.timestamp) {
153 debugBelch("%9" FMT_Word64 ": ", stat_getElapsedTime());
154 }
155 }
156 #endif
157
158 #ifdef DEBUG
159 static char *thread_stop_reasons[] = {
160 [HeapOverflow] = "heap overflow",
161 [StackOverflow] = "stack overflow",
162 [ThreadYielding] = "yielding",
163 [ThreadBlocked] = "blocked",
164 [ThreadFinished] = "finished",
165 [THREAD_SUSPENDED_FOREIGN_CALL] = "suspended while making a foreign call",
166 [6 + BlockedOnMVar] = "blocked on an MVar",
167 [6 + BlockedOnBlackHole] = "blocked on a black hole",
168 [6 + BlockedOnRead] = "blocked on a read operation",
169 [6 + BlockedOnWrite] = "blocked on a write operation",
170 [6 + BlockedOnDelay] = "blocked on a delay operation",
171 [6 + BlockedOnSTM] = "blocked on STM",
172 [6 + BlockedOnDoProc] = "blocked on asyncDoProc",
173 [6 + BlockedOnCCall] = "blocked on a foreign call",
174 [6 + BlockedOnCCall_Interruptible] = "blocked on a foreign call (interruptible)",
175 [6 + BlockedOnMsgThrowTo] = "blocked on throwTo",
176 [6 + ThreadMigrating] = "migrating"
177 };
178 #endif
179
180 #ifdef DEBUG
181 static void traceSchedEvent_stderr (Capability *cap, EventTypeNum tag,
182 StgTSO *tso,
183 StgWord info1 STG_UNUSED,
184 StgWord info2 STG_UNUSED)
185 {
186 ACQUIRE_LOCK(&trace_utx);
187
188 tracePreface();
189 switch (tag) {
190 case EVENT_CREATE_THREAD: // (cap, thread)
191 debugBelch("cap %d: created thread %lu\n",
192 cap->no, (lnat)tso->id);
193 break;
194 case EVENT_RUN_THREAD: // (cap, thread)
195 debugBelch("cap %d: running thread %lu (%s)\n",
196 cap->no, (lnat)tso->id, what_next_strs[tso->what_next]);
197 break;
198 case EVENT_THREAD_RUNNABLE: // (cap, thread)
199 debugBelch("cap %d: thread %lu appended to run queue\n",
200 cap->no, (lnat)tso->id);
201 break;
202 case EVENT_MIGRATE_THREAD: // (cap, thread, new_cap)
203 debugBelch("cap %d: thread %lu migrating to cap %d\n",
204 cap->no, (lnat)tso->id, (int)info1);
205 break;
206 case EVENT_THREAD_WAKEUP: // (cap, thread, info1_cap)
207 debugBelch("cap %d: waking up thread %lu on cap %d\n",
208 cap->no, (lnat)tso->id, (int)info1);
209 break;
210
211 case EVENT_STOP_THREAD: // (cap, thread, status)
212 if (info1 == 6 + BlockedOnBlackHole) {
213 debugBelch("cap %d: thread %lu stopped (blocked on black hole owned by thread %lu)\n",
214 cap->no, (lnat)tso->id, (long)info2);
215 } else {
216 debugBelch("cap %d: thread %lu stopped (%s)\n",
217 cap->no, (lnat)tso->id, thread_stop_reasons[info1]);
218 }
219 break;
220 case EVENT_SHUTDOWN: // (cap)
221 debugBelch("cap %d: shutting down\n", cap->no);
222 break;
223 default:
224 debugBelch("cap %d: thread %lu: event %d\n\n",
225 cap->no, (lnat)tso->id, tag);
226 break;
227 }
228
229 RELEASE_LOCK(&trace_utx);
230 }
231 #endif
232
233 void traceSchedEvent_ (Capability *cap, EventTypeNum tag,
234 StgTSO *tso, StgWord info1, StgWord info2)
235 {
236 #ifdef DEBUG
237 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
238 traceSchedEvent_stderr(cap, tag, tso, info1, info2);
239 } else
240 #endif
241 {
242 postSchedEvent(cap,tag,tso ? tso->id : 0, info1, info2);
243 }
244 }
245
246 #ifdef DEBUG
247 static void traceGcEvent_stderr (Capability *cap, EventTypeNum tag)
248 {
249 ACQUIRE_LOCK(&trace_utx);
250
251 tracePreface();
252 switch (tag) {
253 case EVENT_REQUEST_SEQ_GC: // (cap)
254 debugBelch("cap %d: requesting sequential GC\n", cap->no);
255 break;
256 case EVENT_REQUEST_PAR_GC: // (cap)
257 debugBelch("cap %d: requesting parallel GC\n", cap->no);
258 break;
259 case EVENT_GC_START: // (cap)
260 debugBelch("cap %d: starting GC\n", cap->no);
261 break;
262 case EVENT_GC_END: // (cap)
263 debugBelch("cap %d: finished GC\n", cap->no);
264 break;
265 case EVENT_GC_IDLE: // (cap)
266 debugBelch("cap %d: GC idle\n", cap->no);
267 break;
268 case EVENT_GC_WORK: // (cap)
269 debugBelch("cap %d: GC working\n", cap->no);
270 break;
271 case EVENT_GC_DONE: // (cap)
272 debugBelch("cap %d: GC done\n", cap->no);
273 break;
274 default:
275 barf("traceGcEvent: unknown event tag %d", tag);
276 break;
277 }
278
279 RELEASE_LOCK(&trace_utx);
280 }
281 #endif
282
283 void traceGcEvent_ (Capability *cap, EventTypeNum tag)
284 {
285 #ifdef DEBUG
286 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
287 traceGcEvent_stderr(cap, tag);
288 } else
289 #endif
290 {
291 /* currently all GC events are nullary events */
292 postEvent(cap, tag);
293 }
294 }
295
296 void traceCapsetModify_ (EventTypeNum tag,
297 CapsetID capset,
298 StgWord32 other)
299 {
300 #ifdef DEBUG
301 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
302 ACQUIRE_LOCK(&trace_utx);
303
304 tracePreface();
305 switch (tag) {
306 case EVENT_CAPSET_CREATE: // (capset, capset_type)
307 debugBelch("created capset %lu of type %d\n", (lnat)capset, (int)other);
308 break;
309 case EVENT_CAPSET_DELETE: // (capset)
310 debugBelch("deleted capset %lu\n", (lnat)capset);
311 break;
312 case EVENT_CAPSET_ASSIGN_CAP: // (capset, capno)
313 debugBelch("assigned cap %lu to capset %lu\n",
314 (lnat)other, (lnat)capset);
315 break;
316 case EVENT_CAPSET_REMOVE_CAP: // (capset, capno)
317 debugBelch("removed cap %lu from capset %lu\n",
318 (lnat)other, (lnat)capset);
319 break;
320 }
321 RELEASE_LOCK(&trace_utx);
322 } else
323 #endif
324 {
325 if (eventlog_enabled) {
326 postCapsetModifyEvent(tag, capset, other);
327 }
328 }
329 }
330
331 void traceOSProcessInfo_(void) {
332 if (eventlog_enabled) {
333 postCapsetModifyEvent(EVENT_OSPROCESS_PID,
334 CAPSET_OSPROCESS_DEFAULT,
335 getpid());
336
337 #if !defined(cygwin32_HOST_OS) && !defined (mingw32_HOST_OS)
338 /* Windows has no strong concept of process heirarchy, so no getppid().
339 * In any case, this trace event is mainly useful for tracing programs
340 * that use 'forkProcess' which Windows doesn't support anyway.
341 */
342 postCapsetModifyEvent(EVENT_OSPROCESS_PPID,
343 CAPSET_OSPROCESS_DEFAULT,
344 getppid());
345 #endif
346 {
347 char buf[256];
348 snprintf(buf, sizeof(buf), "GHC-%s %s", ProjectVersion, RtsWay);
349 postCapsetStrEvent(EVENT_RTS_IDENTIFIER,
350 CAPSET_OSPROCESS_DEFAULT,
351 buf);
352 }
353 {
354 int argc = 0; char **argv;
355 getFullProgArgv(&argc, &argv);
356 if (argc != 0) {
357 postCapsetVecEvent(EVENT_PROGRAM_ARGS,
358 CAPSET_OSPROCESS_DEFAULT,
359 argc, argv);
360 }
361 }
362 {
363 int envc = 0; char **envv;
364 getProgEnvv(&envc, &envv);
365 if (envc != 0) {
366 postCapsetVecEvent(EVENT_PROGRAM_ENV,
367 CAPSET_OSPROCESS_DEFAULT,
368 envc, envv);
369 }
370 freeProgEnvv(envc, envv);
371 }
372 }
373 }
374
375 #ifdef DEBUG
376 static void traceSparkEvent_stderr (Capability *cap, EventTypeNum tag,
377 StgWord info1)
378 {
379 ACQUIRE_LOCK(&trace_utx);
380
381 tracePreface();
382 switch (tag) {
383
384 case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
385 debugBelch("cap %d: creating spark thread %lu\n",
386 cap->no, (long)info1);
387 break;
388 case EVENT_SPARK_CREATE: // (cap)
389 debugBelch("cap %d: added spark to pool\n",
390 cap->no);
391 break;
392 case EVENT_SPARK_DUD: // (cap)
393 debugBelch("cap %d: discarded dud spark\n",
394 cap->no);
395 break;
396 case EVENT_SPARK_OVERFLOW: // (cap)
397 debugBelch("cap %d: discarded overflowed spark\n",
398 cap->no);
399 break;
400 case EVENT_SPARK_RUN: // (cap)
401 debugBelch("cap %d: running a spark\n",
402 cap->no);
403 break;
404 case EVENT_SPARK_STEAL: // (cap, victim_cap)
405 debugBelch("cap %d: stealing a spark from cap %d\n",
406 cap->no, (int)info1);
407 break;
408 case EVENT_SPARK_FIZZLE: // (cap)
409 debugBelch("cap %d: fizzled spark removed from pool\n",
410 cap->no);
411 break;
412 case EVENT_SPARK_GC: // (cap)
413 debugBelch("cap %d: GCd spark removed from pool\n",
414 cap->no);
415 break;
416 default:
417 barf("traceSparkEvent: unknown event tag %d", tag);
418 break;
419 }
420
421 RELEASE_LOCK(&trace_utx);
422 }
423 #endif
424
425 void traceSparkEvent_ (Capability *cap, EventTypeNum tag, StgWord info1)
426 {
427 #ifdef DEBUG
428 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
429 traceSparkEvent_stderr(cap, tag, info1);
430 } else
431 #endif
432 {
433 postSparkEvent(cap,tag,info1);
434 }
435 }
436
437 void traceSparkCounters_ (Capability *cap,
438 SparkCounters counters,
439 StgWord remaining)
440 {
441 #ifdef DEBUG
442 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
443 /* we currently don't do debug tracing of spark stats but we must
444 test for TRACE_STDERR because of the !eventlog_enabled case. */
445 } else
446 #endif
447 {
448 postSparkCountersEvent(cap, counters, remaining);
449 }
450 }
451
452 #ifdef DEBUG
453 static void traceCap_stderr(Capability *cap, char *msg, va_list ap)
454 {
455 ACQUIRE_LOCK(&trace_utx);
456
457 tracePreface();
458 debugBelch("cap %d: ", cap->no);
459 vdebugBelch(msg,ap);
460 debugBelch("\n");
461
462 RELEASE_LOCK(&trace_utx);
463 }
464 #endif
465
466 void traceCap_(Capability *cap, char *msg, ...)
467 {
468 va_list ap;
469 va_start(ap,msg);
470
471 #ifdef DEBUG
472 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
473 traceCap_stderr(cap, msg, ap);
474 } else
475 #endif
476 {
477 postCapMsg(cap, msg, ap);
478 }
479
480 va_end(ap);
481 }
482
483 #ifdef DEBUG
484 static void trace_stderr(char *msg, va_list ap)
485 {
486 ACQUIRE_LOCK(&trace_utx);
487
488 tracePreface();
489 vdebugBelch(msg,ap);
490 debugBelch("\n");
491
492 RELEASE_LOCK(&trace_utx);
493 }
494 #endif
495
496 void trace_(char *msg, ...)
497 {
498 va_list ap;
499 va_start(ap,msg);
500
501 #ifdef DEBUG
502 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
503 trace_stderr(msg, ap);
504 } else
505 #endif
506 {
507 postMsg(msg, ap);
508 }
509
510 va_end(ap);
511 }
512
513 static void traceFormatUserMsg(Capability *cap, char *msg, ...)
514 {
515 va_list ap;
516 va_start(ap,msg);
517
518 #ifdef DEBUG
519 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
520 traceCap_stderr(cap, msg, ap);
521 } else
522 #endif
523 {
524 if (eventlog_enabled) {
525 postUserMsg(cap, msg, ap);
526 }
527 }
528 dtraceUserMsg(cap->no, msg);
529 }
530
531 void traceUserMsg(Capability *cap, char *msg)
532 {
533 traceFormatUserMsg(cap, "%s", msg);
534 }
535
536 void traceThreadStatus_ (StgTSO *tso USED_IF_DEBUG)
537 {
538 #ifdef DEBUG
539 if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
540 printThreadStatus(tso);
541 } else
542 #endif
543 {
544 /* nothing - no event for this one yet */
545 }
546 }
547
548 void traceEventStartup_(int nocaps)
549 {
550 if (eventlog_enabled) {
551 postEventStartup(nocaps);
552 }
553 }
554
555 #ifdef DEBUG
556 void traceBegin (const char *str, ...)
557 {
558 va_list ap;
559 va_start(ap,str);
560
561 ACQUIRE_LOCK(&trace_utx);
562
563 tracePreface();
564 vdebugBelch(str,ap);
565 }
566
567 void traceEnd (void)
568 {
569 debugBelch("\n");
570 RELEASE_LOCK(&trace_utx);
571 }
572 #endif /* DEBUG */
573
574 #endif /* TRACING */
575
576 // If DTRACE is enabled, but neither DEBUG nor TRACING, we need a C land
577 // wrapper for the user-msg probe (as we can't expand that in PrimOps.cmm)
578 //
579 #if !defined(DEBUG) && !defined(TRACING) && defined(DTRACE)
580
581 void dtraceUserMsgWrapper(Capability *cap, char *msg)
582 {
583 dtraceUserMsg(cap->no, msg);
584 }
585
586 #endif /* !defined(DEBUG) && !defined(TRACING) && defined(DTRACE) */