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