fix warnings
[ghc.git] / rts / Profiling.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2000
4 *
5 * Support for profiling
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #ifdef PROFILING
10
11 #include "PosixSource.h"
12 #include "Rts.h"
13 #include "RtsUtils.h"
14 #include "RtsFlags.h"
15 #include "Profiling.h"
16 #include "Storage.h"
17 #include "Proftimer.h"
18 #include "Timer.h"
19 #include "ProfHeap.h"
20 #include "Arena.h"
21 #include "RetainerProfile.h"
22 #include "LdvProfile.h"
23
24 #include <string.h>
25
26 /*
27 * Profiling allocation arena.
28 */
29 Arena *prof_arena;
30
31 /*
32 * Global variables used to assign unique IDs to cc's, ccs's, and
33 * closure_cats
34 */
35
36 unsigned int CC_ID;
37 unsigned int CCS_ID;
38 unsigned int HP_ID;
39
40 /* figures for the profiling report.
41 */
42 static ullong total_alloc;
43 static lnat total_prof_ticks;
44
45 /* Globals for opening the profiling log file(s)
46 */
47 static char *prof_filename; /* prof report file name = <program>.prof */
48 FILE *prof_file;
49
50 static char *hp_filename; /* heap profile (hp2ps style) log file */
51 FILE *hp_file;
52
53 /* The Current Cost Centre Stack (for attributing costs)
54 */
55 CostCentreStack *CCCS;
56
57 /* Linked lists to keep track of cc's and ccs's that haven't
58 * been declared in the log file yet
59 */
60 CostCentre *CC_LIST;
61 CostCentreStack *CCS_LIST;
62
63 /*
64 * Built-in cost centres and cost-centre stacks:
65 *
66 * MAIN is the root of the cost-centre stack tree. If there are
67 * no _scc_s in the program, all costs will be attributed
68 * to MAIN.
69 *
70 * SYSTEM is the RTS in general (scheduler, etc.). All costs for
71 * RTS operations apart from garbage collection are attributed
72 * to SYSTEM.
73 *
74 * GC is the storage manager / garbage collector.
75 *
76 * OVERHEAD gets all costs generated by the profiling system
77 * itself. These are costs that would not be incurred
78 * during non-profiled execution of the program.
79 *
80 * SUBSUMED is the one-and-only CCS placed on top-level functions.
81 * It indicates that all costs are to be attributed to the
82 * enclosing cost centre stack. SUBSUMED never accumulates
83 * any costs. The is_caf flag is set on the subsumed cost
84 * centre.
85 *
86 * DONT_CARE is a placeholder cost-centre we assign to static
87 * constructors. It should *never* accumulate any costs.
88 */
89
90 CC_DECLARE(CC_MAIN, "MAIN", "MAIN", CC_IS_BORING, );
91 CC_DECLARE(CC_SYSTEM, "SYSTEM", "MAIN", CC_IS_BORING, );
92 CC_DECLARE(CC_GC, "GC", "GC", CC_IS_BORING, );
93 CC_DECLARE(CC_OVERHEAD, "OVERHEAD_of", "PROFILING", CC_IS_CAF, );
94 CC_DECLARE(CC_SUBSUMED, "SUBSUMED", "MAIN", CC_IS_CAF, );
95 CC_DECLARE(CC_DONT_CARE, "DONT_CARE", "MAIN", CC_IS_BORING, );
96
97 CCS_DECLARE(CCS_MAIN, CC_MAIN, );
98 CCS_DECLARE(CCS_SYSTEM, CC_SYSTEM, );
99 CCS_DECLARE(CCS_GC, CC_GC, );
100 CCS_DECLARE(CCS_OVERHEAD, CC_OVERHEAD, );
101 CCS_DECLARE(CCS_SUBSUMED, CC_SUBSUMED, );
102 CCS_DECLARE(CCS_DONT_CARE, CC_DONT_CARE, );
103
104 /*
105 * Uniques for the XML log-file format
106 */
107 #define CC_UQ 1
108 #define CCS_UQ 2
109 #define TC_UQ 3
110 #define HEAP_OBJ_UQ 4
111 #define TIME_UPD_UQ 5
112 #define HEAP_UPD_UQ 6
113
114 /*
115 * Static Functions
116 */
117
118 static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc,
119 CostCentreStack *new_ccs );
120 static rtsBool ccs_to_ignore ( CostCentreStack *ccs );
121 static void count_ticks ( CostCentreStack *ccs );
122 static void inherit_costs ( CostCentreStack *ccs );
123 static void reportCCS ( CostCentreStack *ccs, nat indent );
124 static void DecCCS ( CostCentreStack *ccs );
125 static void DecBackEdge ( CostCentreStack *ccs,
126 CostCentreStack *oldccs );
127 static CostCentreStack * CheckLoop ( CostCentreStack *ccs, CostCentre *cc );
128 static CostCentreStack * pruneCCSTree ( CostCentreStack *ccs );
129 static CostCentreStack * ActualPush ( CostCentreStack *, CostCentre * );
130 static CostCentreStack * IsInIndexTable ( IndexTable *, CostCentre * );
131 static IndexTable * AddToIndexTable ( IndexTable *, CostCentreStack *,
132 CostCentre *, unsigned int );
133 static void ccsSetSelected ( CostCentreStack *ccs );
134
135 static void initTimeProfiling ( void );
136 static void initProfilingLogFile( void );
137
138 static void reportCCS_XML ( CostCentreStack *ccs );
139
140 /* -----------------------------------------------------------------------------
141 Initialise the profiling environment
142 -------------------------------------------------------------------------- */
143
144 void
145 initProfiling1 (void)
146 {
147 // initialise our arena
148 prof_arena = newArena();
149
150 /* for the benefit of allocate()... */
151 CCCS = CCS_SYSTEM;
152
153 /* Initialize counters for IDs */
154 CC_ID = 1;
155 CCS_ID = 1;
156 HP_ID = 1;
157
158 /* Initialize Declaration lists to NULL */
159 CC_LIST = NULL;
160 CCS_LIST = NULL;
161
162 /* Register all the cost centres / stacks in the program
163 * CC_MAIN gets link = 0, all others have non-zero link.
164 */
165 REGISTER_CC(CC_MAIN);
166 REGISTER_CC(CC_SYSTEM);
167 REGISTER_CC(CC_GC);
168 REGISTER_CC(CC_OVERHEAD);
169 REGISTER_CC(CC_SUBSUMED);
170 REGISTER_CC(CC_DONT_CARE);
171 REGISTER_CCS(CCS_MAIN);
172 REGISTER_CCS(CCS_SYSTEM);
173 REGISTER_CCS(CCS_GC);
174 REGISTER_CCS(CCS_OVERHEAD);
175 REGISTER_CCS(CCS_SUBSUMED);
176 REGISTER_CCS(CCS_DONT_CARE);
177
178 CCCS = CCS_OVERHEAD;
179
180 /* cost centres are registered by the per-module
181 * initialisation code now...
182 */
183 }
184
185 void
186 initProfiling2 (void)
187 {
188 CostCentreStack *ccs, *next;
189
190 CCCS = CCS_SYSTEM;
191
192 /* Set up the log file, and dump the header and cost centre
193 * information into it. */
194 initProfilingLogFile();
195
196 /* find all the "special" cost centre stacks, and make them children
197 * of CCS_MAIN.
198 */
199 ASSERT(CCS_MAIN->prevStack == 0);
200 CCS_MAIN->root = CC_MAIN;
201 ccsSetSelected(CCS_MAIN);
202 DecCCS(CCS_MAIN);
203
204 for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
205 next = ccs->prevStack;
206 ccs->prevStack = 0;
207 ActualPush_(CCS_MAIN,ccs->cc,ccs);
208 ccs->root = ccs->cc;
209 ccs = next;
210 }
211
212 if (RtsFlags.CcFlags.doCostCentres) {
213 initTimeProfiling();
214 }
215
216 if (RtsFlags.ProfFlags.doHeapProfile) {
217 initHeapProfiling();
218 }
219 }
220
221 // Decide whether closures with this CCS should contribute to the heap
222 // profile.
223 static void
224 ccsSetSelected( CostCentreStack *ccs )
225 {
226 if (RtsFlags.ProfFlags.modSelector) {
227 if (! strMatchesSelector( ccs->cc->module,
228 RtsFlags.ProfFlags.modSelector ) ) {
229 ccs->selected = 0;
230 return;
231 }
232 }
233 if (RtsFlags.ProfFlags.ccSelector) {
234 if (! strMatchesSelector( ccs->cc->label,
235 RtsFlags.ProfFlags.ccSelector ) ) {
236 ccs->selected = 0;
237 return;
238 }
239 }
240 if (RtsFlags.ProfFlags.ccsSelector) {
241 CostCentreStack *c;
242 for (c = ccs; c != NULL; c = c->prevStack) {
243 if ( strMatchesSelector( c->cc->label,
244 RtsFlags.ProfFlags.ccsSelector )) {
245 break;
246 }
247 }
248 if (c == NULL) {
249 ccs->selected = 0;
250 return;
251 }
252 }
253
254 ccs->selected = 1;
255 return;
256 }
257
258
259 static void
260 initProfilingLogFile(void)
261 {
262 /* Initialise the log file name */
263 prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
264 sprintf(prof_filename, "%s.prof", prog_name);
265
266 /* open the log file */
267 if ((prof_file = fopen(prof_filename, "w")) == NULL) {
268 debugBelch("Can't open profiling report file %s\n", prof_filename);
269 RtsFlags.CcFlags.doCostCentres = 0;
270 // The following line was added by Sung; retainer/LDV profiling may need
271 // two output files, i.e., <program>.prof/hp.
272 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
273 RtsFlags.ProfFlags.doHeapProfile = 0;
274 return;
275 }
276
277 if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
278 /* dump the time, and the profiling interval */
279 fprintf(prof_file, "\"%s\"\n", time_str());
280 fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
281
282 /* declare all the cost centres */
283 {
284 CostCentre *cc;
285 for (cc = CC_LIST; cc != NULL; cc = cc->link) {
286 fprintf(prof_file, "%d %ld \"%s\" \"%s\"\n",
287 CC_UQ, cc->ccID, cc->label, cc->module);
288 }
289 }
290 }
291
292 if (RtsFlags.ProfFlags.doHeapProfile) {
293 /* Initialise the log file name */
294 hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
295 sprintf(hp_filename, "%s.hp", prog_name);
296
297 /* open the log file */
298 if ((hp_file = fopen(hp_filename, "w")) == NULL) {
299 debugBelch("Can't open profiling report file %s\n",
300 hp_filename);
301 RtsFlags.ProfFlags.doHeapProfile = 0;
302 return;
303 }
304 }
305 }
306
307 void
308 initTimeProfiling(void)
309 {
310 /* Start ticking */
311 startProfTimer();
312 };
313
314 void
315 endProfiling ( void )
316 {
317 if (RtsFlags.CcFlags.doCostCentres) {
318 stopProfTimer();
319 }
320 if (RtsFlags.ProfFlags.doHeapProfile) {
321 endHeapProfiling();
322 }
323 }
324
325 /* -----------------------------------------------------------------------------
326 Set cost centre stack when entering a function.
327 -------------------------------------------------------------------------- */
328 rtsBool entering_PAP;
329
330 void
331 EnterFunCCS ( CostCentreStack *ccsfn )
332 {
333 /* PAP_entry has already set CCCS for us */
334 if (entering_PAP) {
335 entering_PAP = rtsFalse;
336 return;
337 }
338
339 if (ccsfn->root->is_caf == CC_IS_CAF) {
340 CCCS = AppendCCS(CCCS,ccsfn);
341 } else {
342 CCCS = ccsfn;
343 }
344 }
345
346 /* -----------------------------------------------------------------------------
347 Cost-centre stack manipulation
348 -------------------------------------------------------------------------- */
349
350 #ifdef DEBUG
351 CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
352 CostCentreStack *
353 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
354 #define PushCostCentre _PushCostCentre
355 {
356 IF_DEBUG(prof,
357 debugBelch("Pushing %s on ", cc->label);
358 debugCCS(ccs);
359 debugBelch("\n"));
360 return PushCostCentre(ccs,cc);
361 }
362 #endif
363
364 CostCentreStack *
365 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
366 {
367 CostCentreStack *temp_ccs;
368
369 if (ccs == EMPTY_STACK)
370 return ActualPush(ccs,cc);
371 else {
372 if (ccs->cc == cc)
373 return ccs;
374 else {
375 /* check if we've already memoized this stack */
376 temp_ccs = IsInIndexTable(ccs->indexTable,cc);
377
378 if (temp_ccs != EMPTY_STACK)
379 return temp_ccs;
380 else {
381 temp_ccs = CheckLoop(ccs,cc);
382 if (temp_ccs != NULL) {
383 /* we have recursed to an older CCS. Mark this in
384 * the index table, and emit a "back edge" into the
385 * log file.
386 */
387 ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1);
388 DecBackEdge(temp_ccs,ccs);
389 return temp_ccs;
390 } else {
391 return ActualPush(ccs,cc);
392 }
393 }
394 }
395 }
396 }
397
398 static CostCentreStack *
399 CheckLoop ( CostCentreStack *ccs, CostCentre *cc )
400 {
401 while (ccs != EMPTY_STACK) {
402 if (ccs->cc == cc)
403 return ccs;
404 ccs = ccs->prevStack;
405 }
406 return NULL;
407 }
408
409 /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
410
411 #ifdef DEBUG
412 CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
413 CostCentreStack *
414 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
415 #define AppendCCS _AppendCCS
416 {
417 IF_DEBUG(prof,
418 if (ccs1 != ccs2) {
419 debugBelch("Appending ");
420 debugCCS(ccs1);
421 debugBelch(" to ");
422 debugCCS(ccs2);
423 debugBelch("\n");});
424 return AppendCCS(ccs1,ccs2);
425 }
426 #endif
427
428 CostCentreStack *
429 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
430 {
431 CostCentreStack *ccs = NULL;
432
433 if (ccs1 == ccs2) {
434 return ccs1;
435 }
436
437 if (ccs2->cc->is_caf == CC_IS_CAF) {
438 return ccs1;
439 }
440
441 if (ccs2->prevStack != NULL) {
442 ccs = AppendCCS(ccs1, ccs2->prevStack);
443 }
444
445 return PushCostCentre(ccs,ccs2->cc);
446 }
447
448 static CostCentreStack *
449 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
450 {
451 CostCentreStack *new_ccs;
452
453 /* allocate space for a new CostCentreStack */
454 new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
455
456 return ActualPush_(ccs, cc, new_ccs);
457 }
458
459 static CostCentreStack *
460 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
461 {
462 /* assign values to each member of the structure */
463 new_ccs->ccsID = CCS_ID++;
464 new_ccs->cc = cc;
465 new_ccs->prevStack = ccs;
466
467 new_ccs->indexTable = EMPTY_TABLE;
468
469 /* Initialise the various _scc_ counters to zero
470 */
471 new_ccs->scc_count = 0;
472
473 /* Initialize all other stats here. There should be a quick way
474 * that's easily used elsewhere too
475 */
476 new_ccs->time_ticks = 0;
477 new_ccs->mem_alloc = 0;
478 new_ccs->inherited_ticks = 0;
479 new_ccs->inherited_alloc = 0;
480
481 new_ccs->root = ccs->root;
482
483 // Set the selected field.
484 ccsSetSelected(new_ccs);
485
486 /* update the memoization table for the parent stack */
487 if (ccs != EMPTY_STACK)
488 ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc,
489 0/*not a back edge*/);
490
491 /* make sure this CC is declared at the next heap/time sample */
492 DecCCS(new_ccs);
493
494 /* return a pointer to the new stack */
495 return new_ccs;
496 }
497
498
499 static CostCentreStack *
500 IsInIndexTable(IndexTable *it, CostCentre *cc)
501 {
502 while (it!=EMPTY_TABLE)
503 {
504 if (it->cc==cc)
505 return it->ccs;
506 else
507 it = it->next;
508 }
509
510 /* otherwise we never found it so return EMPTY_TABLE */
511 return EMPTY_TABLE;
512 }
513
514
515 static IndexTable *
516 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
517 CostCentre *cc, unsigned int back_edge)
518 {
519 IndexTable *new_it;
520
521 new_it = arenaAlloc(prof_arena, sizeof(IndexTable));
522
523 new_it->cc = cc;
524 new_it->ccs = new_ccs;
525 new_it->next = it;
526 new_it->back_edge = back_edge;
527 return new_it;
528 }
529
530
531 static void
532 DecCCS(CostCentreStack *ccs)
533 {
534 if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
535 if (ccs->prevStack == EMPTY_STACK)
536 fprintf(prof_file, "%d %ld 1 %ld\n", CCS_UQ,
537 ccs->ccsID, ccs->cc->ccID);
538 else
539 fprintf(prof_file, "%d %ld 2 %ld %ld\n", CCS_UQ,
540 ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
541 }
542 }
543
544 static void
545 DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
546 {
547 if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
548 if (ccs->prevStack == EMPTY_STACK)
549 fprintf(prof_file, "%d %ld 1 %ld\n", CCS_UQ,
550 ccs->ccsID, ccs->cc->ccID);
551 else
552 fprintf(prof_file, "%d %ld 2 %ld %ld\n", CCS_UQ,
553 ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
554 }
555 }
556
557 /* -----------------------------------------------------------------------------
558 Generating a time & allocation profiling report.
559 -------------------------------------------------------------------------- */
560
561 /* We omit certain system-related CCs and CCSs from the default
562 * reports, so as not to cause confusion.
563 */
564 static rtsBool
565 cc_to_ignore (CostCentre *cc)
566 {
567 if ( cc == CC_OVERHEAD
568 || cc == CC_DONT_CARE
569 || cc == CC_GC
570 || cc == CC_SYSTEM) {
571 return rtsTrue;
572 } else {
573 return rtsFalse;
574 }
575 }
576
577 static rtsBool
578 ccs_to_ignore (CostCentreStack *ccs)
579 {
580 if ( ccs == CCS_OVERHEAD
581 || ccs == CCS_DONT_CARE
582 || ccs == CCS_GC
583 || ccs == CCS_SYSTEM) {
584 return rtsTrue;
585 } else {
586 return rtsFalse;
587 }
588 }
589
590 /* -----------------------------------------------------------------------------
591 Generating the aggregated per-cost-centre time/alloc report.
592 -------------------------------------------------------------------------- */
593
594 static CostCentre *sorted_cc_list;
595
596 static void
597 aggregate_cc_costs( CostCentreStack *ccs )
598 {
599 IndexTable *i;
600
601 ccs->cc->mem_alloc += ccs->mem_alloc;
602 ccs->cc->time_ticks += ccs->time_ticks;
603
604 for (i = ccs->indexTable; i != 0; i = i->next) {
605 if (!i->back_edge) {
606 aggregate_cc_costs(i->ccs);
607 }
608 }
609 }
610
611 static void
612 insert_cc_in_sorted_list( CostCentre *new_cc )
613 {
614 CostCentre **prev, *cc;
615
616 prev = &sorted_cc_list;
617 for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
618 if (new_cc->time_ticks > cc->time_ticks) {
619 new_cc->link = cc;
620 *prev = new_cc;
621 return;
622 } else {
623 prev = &(cc->link);
624 }
625 }
626 new_cc->link = NULL;
627 *prev = new_cc;
628 }
629
630 static void
631 report_per_cc_costs( void )
632 {
633 CostCentre *cc, *next;
634
635 aggregate_cc_costs(CCS_MAIN);
636 sorted_cc_list = NULL;
637
638 for (cc = CC_LIST; cc != NULL; cc = next) {
639 next = cc->link;
640 if (cc->time_ticks > total_prof_ticks/100
641 || cc->mem_alloc > total_alloc/100
642 || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
643 insert_cc_in_sorted_list(cc);
644 }
645 }
646
647 fprintf(prof_file, "%-30s %-20s", "COST CENTRE", "MODULE");
648 fprintf(prof_file, "%6s %6s", "%time", "%alloc");
649 if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
650 fprintf(prof_file, " %5s %9s", "ticks", "bytes");
651 }
652 fprintf(prof_file, "\n\n");
653
654 for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
655 if (cc_to_ignore(cc)) {
656 continue;
657 }
658 fprintf(prof_file, "%-30s %-20s", cc->label, cc->module);
659 fprintf(prof_file, "%6.1f %6.1f",
660 total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
661 total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
662 total_alloc * 100)
663 );
664
665 if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
666 fprintf(prof_file, " %5" FMT_Word64 " %9" FMT_Word64,
667 (StgWord64)(cc->time_ticks), cc->mem_alloc);
668 }
669 fprintf(prof_file, "\n");
670 }
671
672 fprintf(prof_file,"\n\n");
673 }
674
675 /* -----------------------------------------------------------------------------
676 Generate the cost-centre-stack time/alloc report
677 -------------------------------------------------------------------------- */
678
679 static void
680 fprint_header( void )
681 {
682 fprintf(prof_file, "%-24s %-10s individual inherited\n", "", "");
683
684 fprintf(prof_file, "%-24s %-50s", "COST CENTRE", "MODULE");
685 fprintf(prof_file, "%6s %10s %5s %5s %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
686
687 if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
688 fprintf(prof_file, " %5s %9s", "ticks", "bytes");
689 #if defined(PROFILING_DETAIL_COUNTS)
690 fprintf(prof_file, " %8s %8s %8s %8s %8s %8s %8s",
691 "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
692 #endif
693 }
694
695 fprintf(prof_file, "\n\n");
696 }
697
698 void
699 reportCCSProfiling( void )
700 {
701 nat count;
702 char temp[128]; /* sigh: magic constant */
703
704 stopProfTimer();
705
706 total_prof_ticks = 0;
707 total_alloc = 0;
708 count_ticks(CCS_MAIN);
709
710 switch (RtsFlags.CcFlags.doCostCentres) {
711 case 0:
712 return;
713 case COST_CENTRES_XML:
714 gen_XML_logfile();
715 return;
716 default:
717 break;
718 }
719
720 fprintf(prof_file, "\t%s Time and Allocation Profiling Report (%s)\n",
721 time_str(), "Final");
722
723 fprintf(prof_file, "\n\t ");
724 fprintf(prof_file, " %s", prog_name);
725 fprintf(prof_file, " +RTS");
726 for (count = 0; rts_argv[count]; count++)
727 fprintf(prof_file, " %s", rts_argv[count]);
728 fprintf(prof_file, " -RTS");
729 for (count = 1; prog_argv[count]; count++)
730 fprintf(prof_file, " %s", prog_argv[count]);
731 fprintf(prof_file, "\n\n");
732
733 fprintf(prof_file, "\ttotal time = %11.2f secs (%lu ticks @ %d ms)\n",
734 total_prof_ticks / (StgFloat) TICK_FREQUENCY,
735 total_prof_ticks, TICK_MILLISECS);
736
737 fprintf(prof_file, "\ttotal alloc = %11s bytes",
738 ullong_format_string(total_alloc * sizeof(W_),
739 temp, rtsTrue/*commas*/));
740
741 #if defined(PROFILING_DETAIL_COUNTS)
742 fprintf(prof_file, " (%lu closures)", total_allocs);
743 #endif
744 fprintf(prof_file, " (excludes profiling overheads)\n\n");
745
746 report_per_cc_costs();
747
748 inherit_costs(CCS_MAIN);
749
750 fprint_header();
751 reportCCS(pruneCCSTree(CCS_MAIN), 0);
752 }
753
754 static void
755 reportCCS(CostCentreStack *ccs, nat indent)
756 {
757 CostCentre *cc;
758 IndexTable *i;
759
760 cc = ccs->cc;
761
762 /* Only print cost centres with non 0 data ! */
763
764 if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
765 ! ccs_to_ignore(ccs))
766 /* force printing of *all* cost centres if -P -P */
767 {
768
769 fprintf(prof_file, "%-*s%-*s %-50s",
770 indent, "", 24-indent, cc->label, cc->module);
771
772 fprintf(prof_file, "%6ld %11.0f %5.1f %5.1f %5.1f %5.1f",
773 ccs->ccsID, (double) ccs->scc_count,
774 total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
775 total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
776 total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
777 total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
778 );
779
780 if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
781 fprintf(prof_file, " %5" FMT_Word64 " %9" FMT_Word64,
782 (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
783 #if defined(PROFILING_DETAIL_COUNTS)
784 fprintf(prof_file, " %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
785 ccs->mem_allocs, ccs->thunk_count,
786 ccs->function_count, ccs->pap_count,
787 ccs->subsumed_fun_count, ccs->subsumed_caf_count,
788 ccs->caffun_subsumed);
789 #endif
790 }
791 fprintf(prof_file, "\n");
792 }
793
794 for (i = ccs->indexTable; i != 0; i = i->next) {
795 if (!i->back_edge) {
796 reportCCS(i->ccs, indent+1);
797 }
798 }
799 }
800
801
802 /* Traverse the cost centre stack tree and accumulate
803 * ticks/allocations.
804 */
805 static void
806 count_ticks(CostCentreStack *ccs)
807 {
808 IndexTable *i;
809
810 if (!ccs_to_ignore(ccs)) {
811 total_alloc += ccs->mem_alloc;
812 total_prof_ticks += ccs->time_ticks;
813 }
814 for (i = ccs->indexTable; i != NULL; i = i->next)
815 if (!i->back_edge) {
816 count_ticks(i->ccs);
817 }
818 }
819
820 /* Traverse the cost centre stack tree and inherit ticks & allocs.
821 */
822 static void
823 inherit_costs(CostCentreStack *ccs)
824 {
825 IndexTable *i;
826
827 if (ccs_to_ignore(ccs)) { return; }
828
829 ccs->inherited_ticks += ccs->time_ticks;
830 ccs->inherited_alloc += ccs->mem_alloc;
831
832 for (i = ccs->indexTable; i != NULL; i = i->next)
833 if (!i->back_edge) {
834 inherit_costs(i->ccs);
835 ccs->inherited_ticks += i->ccs->inherited_ticks;
836 ccs->inherited_alloc += i->ccs->inherited_alloc;
837 }
838
839 return;
840 }
841
842 static CostCentreStack *
843 pruneCCSTree( CostCentreStack *ccs )
844 {
845 CostCentreStack *ccs1;
846 IndexTable *i, **prev;
847
848 prev = &ccs->indexTable;
849 for (i = ccs->indexTable; i != 0; i = i->next) {
850 if (i->back_edge) { continue; }
851
852 ccs1 = pruneCCSTree(i->ccs);
853 if (ccs1 == NULL) {
854 *prev = i->next;
855 } else {
856 prev = &(i->next);
857 }
858 }
859
860 if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
861 /* force printing of *all* cost centres if -P -P */ )
862
863 || ( ccs->indexTable != 0 )
864 || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
865 ) {
866 return ccs;
867 } else {
868 return NULL;
869 }
870 }
871
872 /* -----------------------------------------------------------------------------
873 Generate the XML time/allocation profile
874 -------------------------------------------------------------------------- */
875
876 void
877 gen_XML_logfile( void )
878 {
879 fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
880
881 reportCCS_XML(pruneCCSTree(CCS_MAIN));
882
883 fprintf(prof_file, " 0\n");
884
885 fclose(prof_file);
886 }
887
888 static void
889 reportCCS_XML(CostCentreStack *ccs)
890 {
891 CostCentre *cc;
892 IndexTable *i;
893
894 if (ccs_to_ignore(ccs)) { return; }
895
896 cc = ccs->cc;
897
898 fprintf(prof_file, " 1 %ld %" FMT_Word64 " %" FMT_Word64 " %" FMT_Word64,
899 ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
900
901 for (i = ccs->indexTable; i != 0; i = i->next) {
902 if (!i->back_edge) {
903 reportCCS_XML(i->ccs);
904 }
905 }
906 }
907
908 void
909 fprintCCS( FILE *f, CostCentreStack *ccs )
910 {
911 fprintf(f,"<");
912 for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
913 fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
914 if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
915 fprintf(f,",");
916 }
917 }
918 fprintf(f,">");
919 }
920
921 /* For calling from .cmm code, where we can't reliably refer to stderr */
922 void
923 fprintCCS_stderr( CostCentreStack *ccs )
924 {
925 fprintCCS(stderr, ccs);
926 }
927
928 #ifdef DEBUG
929 void
930 debugCCS( CostCentreStack *ccs )
931 {
932 debugBelch("<");
933 for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
934 debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
935 if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
936 debugBelch(",");
937 }
938 }
939 debugBelch(">");
940 }
941 #endif /* DEBUG */
942
943 #endif /* PROFILING */