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