Profiling.c 32.4 KB
Newer Older
1
2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 1998-2000
4
5
6
7
8
9
10
 *
 * Support for profiling
 *
 * ---------------------------------------------------------------------------*/

#ifdef PROFILING

11
#include "PosixSource.h"
12
#include "Rts.h"
Simon Marlow's avatar
Simon Marlow committed
13

14
#include "RtsUtils.h"
15
#include "Profiling.h"
16
#include "Proftimer.h"
17
#include "ProfHeap.h"
18
#include "Arena.h"
19
#include "RetainerProfile.h"
20
#include "Printer.h"
21
#include "Capability.h"
22

23
24
#include <string.h>

25
26
27
28
#ifdef DEBUG
#include "Trace.h"
#endif

29
30
31
32
/*
 * Profiling allocation arena.
 */
Arena *prof_arena;
33
34
35
36
37
38

/*
 * Global variables used to assign unique IDs to cc's, ccs's, and 
 * closure_cats
 */

39
40
unsigned int CC_ID  = 1;
unsigned int CCS_ID = 1;
41
42
43

/* figures for the profiling report.
 */
Ian Lynagh's avatar
Ian Lynagh committed
44
static StgWord64 total_alloc;
45
static W_      total_prof_ticks;
46

47
/* Globals for opening the profiling log file(s)
48
49
 */
static char *prof_filename; /* prof report file name = <program>.prof */
50
FILE *prof_file;
51

52
53
54
static char *hp_filename;	/* heap profile (hp2ps style) log file */
FILE *hp_file;

55
/* Linked lists to keep track of CCs and CCSs that haven't
56
57
 * been declared in the log file yet
 */
58
59
CostCentre      *CC_LIST  = NULL;
CostCentreStack *CCS_LIST = NULL;
60

61
62
63
64
#ifdef THREADED_RTS
Mutex ccs_mutex;
#endif

65
66
67
68
/*
 * Built-in cost centres and cost-centre stacks:
 *
 *    MAIN   is the root of the cost-centre stack tree.  If there are
69
 *           no {-# SCC #-}s in the program, all costs will be attributed
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 *           to MAIN.
 *
 *    SYSTEM is the RTS in general (scheduler, etc.).  All costs for
 *           RTS operations apart from garbage collection are attributed
 *           to SYSTEM.
 *
 *    GC     is the storage manager / garbage collector.
 *
 *    OVERHEAD gets all costs generated by the profiling system
 *           itself.  These are costs that would not be incurred
 *           during non-profiled execution of the program.
 *
 *    DONT_CARE is a placeholder cost-centre we assign to static
 *           constructors.  It should *never* accumulate any costs.
84
85
86
87
 *
 *    PINNED accumulates memory allocated to pinned objects, which
 *           cannot be profiled separately because we cannot reliably
 *           traverse pinned memory.
88
89
 */

90
91
92
93
94
95
96
CC_DECLARE(CC_MAIN,      "MAIN",        "MAIN",      "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_SYSTEM,    "SYSTEM",      "SYSTEM",    "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_GC,        "GC",          "GC",        "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_PINNED,    "PINNED",      "SYSTEM",    "<built-in>", CC_NOT_CAF, );
CC_DECLARE(CC_IDLE,      "IDLE",        "IDLE",      "<built-in>", CC_NOT_CAF, );
97

98
99
100
101
CCS_DECLARE(CCS_MAIN, 	    CC_MAIN,       );
CCS_DECLARE(CCS_SYSTEM,	    CC_SYSTEM,     );
CCS_DECLARE(CCS_GC,         CC_GC,         );
CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
102
103
CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE,  );
CCS_DECLARE(CCS_PINNED,     CC_PINNED,     );
104
CCS_DECLARE(CCS_IDLE,       CC_IDLE,       );
105

106
/*
107
108
109
 * Static Functions
 */

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
static  CostCentreStack * appendCCS       ( CostCentreStack *ccs1,
                                            CostCentreStack *ccs2 );
static  CostCentreStack * actualPush_     ( CostCentreStack *ccs, CostCentre *cc,
                                            CostCentreStack *new_ccs );
static  rtsBool           ignoreCCS       ( CostCentreStack *ccs );
static  void              countTickss     ( CostCentreStack *ccs );
static  void              inheritCosts    ( CostCentreStack *ccs );
static  void              findCCSMaxLens  ( CostCentreStack *ccs,
                                            nat indent,
                                            nat *max_label_len,
                                            nat *max_module_len );
static  void              logCCS          ( CostCentreStack *ccs,
                                            nat indent,
                                            nat max_label_len,
                                            nat max_module_len );
125
static  void              reportCCS       ( CostCentreStack *ccs );
126
127
static  CostCentreStack * checkLoop       ( CostCentreStack *ccs,
                                            CostCentre *cc );
128
static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
129
130
131
static  CostCentreStack * actualPush      ( CostCentreStack *, CostCentre * );
static  CostCentreStack * isInIndexTable  ( IndexTable *, CostCentre * );
static  IndexTable *      addToIndexTable ( IndexTable *, CostCentreStack *,
132
					    CostCentre *, unsigned int );
133
static  void              ccsSetSelected  ( CostCentreStack *ccs );
134

135
136
static  void              initTimeProfiling    ( void );
static  void              initProfilingLogFile ( void );
137
138
139
140
141
142

/* -----------------------------------------------------------------------------
   Initialise the profiling environment
   -------------------------------------------------------------------------- */

void
143
initProfiling1 (void)
144
{
145
146
    // initialise our arena
    prof_arena = newArena();
147

148
    /* for the benefit of allocate()... */
149
150
151
    {
        nat n;
        for (n=0; n < n_capabilities; n++) {
152
            capabilities[n]->r.rCCCS = CCS_SYSTEM;
153
154
        }
    }
155
156
157
158

#ifdef THREADED_RTS
    initMutex(&ccs_mutex);
#endif
159
160
}

Ian Lynagh's avatar
Ian Lynagh committed
161
void
162
freeProfiling (void)
Ian Lynagh's avatar
Ian Lynagh committed
163
164
165
166
{
    arenaFree(prof_arena);
}

167
168
169
void
initProfiling2 (void)
{
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
    CostCentreStack *ccs, *next;

    /* Set up the log file, and dump the header and cost centre
     * information into it.
     */
    initProfilingLogFile();

    /* Register all the cost centres / stacks in the program
     * CC_MAIN gets link = 0, all others have non-zero link.
     */
    REGISTER_CC(CC_MAIN);
    REGISTER_CC(CC_SYSTEM);
    REGISTER_CC(CC_GC);
    REGISTER_CC(CC_OVERHEAD);
    REGISTER_CC(CC_DONT_CARE);
    REGISTER_CC(CC_PINNED);
186
    REGISTER_CC(CC_IDLE);
187
188
189
190
191
192

    REGISTER_CCS(CCS_SYSTEM);
    REGISTER_CCS(CCS_GC);
    REGISTER_CCS(CCS_OVERHEAD);
    REGISTER_CCS(CCS_DONT_CARE);
    REGISTER_CCS(CCS_PINNED);
193
    REGISTER_CCS(CCS_IDLE);
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    REGISTER_CCS(CCS_MAIN);

    /* find all the registered cost centre stacks, and make them
     * children of CCS_MAIN.
     */
    ASSERT(CCS_LIST == CCS_MAIN);
    CCS_LIST = CCS_LIST->prevStack;
    CCS_MAIN->prevStack = NULL;
    CCS_MAIN->root = CCS_MAIN;
    ccsSetSelected(CCS_MAIN);

    // make CCS_MAIN the parent of all the pre-defined CCSs.
    for (ccs = CCS_LIST; ccs != NULL; ) {
        next = ccs->prevStack;
        ccs->prevStack = NULL;
        actualPush_(CCS_MAIN,ccs->cc,ccs);
        ccs->root = ccs;
        ccs = next;
212
    }
213
214
215

    if (RtsFlags.CcFlags.doCostCentres) {
        initTimeProfiling();
216
217
    }

218
219
220
    if (RtsFlags.ProfFlags.doHeapProfile) {
        initHeapProfiling();
    }
221
222
223
}


224
225
static void
initProfilingLogFile(void)
226
{
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
    char *prog;

    prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
    strcpy(prog, prog_name);
#ifdef mingw32_HOST_OS
    // on Windows, drop the .exe suffix if there is one
    {
        char *suff;
        suff = strrchr(prog,'.');
        if (suff != NULL && !strcmp(suff,".exe")) {
            *suff = '\0';
        }
    }
#endif

242
    if (RtsFlags.CcFlags.doCostCentres == 0 && 
243
244
        RtsFlags.ProfFlags.doHeapProfile != HEAP_BY_RETAINER &&
        RtsFlags.ProfFlags.retainerSelector == NULL)
245
246
247
248
    {
        /* No need for the <prog>.prof file */
        prof_filename = NULL;
        prof_file = NULL;
249
    }
250
251
252
    else
    {
        /* Initialise the log file name */
253
254
        prof_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
        sprintf(prof_filename, "%s.prof", prog);
255
256
257
258
259
260
261
262
263
264
265

        /* open the log file */
        if ((prof_file = fopen(prof_filename, "w")) == NULL) {
            debugBelch("Can't open profiling report file %s\n", prof_filename);
            RtsFlags.CcFlags.doCostCentres = 0;
            // The following line was added by Sung; retainer/LDV profiling may need
            // two output files, i.e., <program>.prof/hp.
            if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
                RtsFlags.ProfFlags.doHeapProfile = 0;
            return;
        }
266
    }
267
    
268
269
    if (RtsFlags.ProfFlags.doHeapProfile) {
	/* Initialise the log file name */
270
271
272
	hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
	sprintf(hp_filename, "%s.hp", prog);

273
274
	/* open the log file */
	if ((hp_file = fopen(hp_filename, "w")) == NULL) {
275
	    debugBelch("Can't open profiling report file %s\n", 
276
277
278
279
		    hp_filename);
	    RtsFlags.ProfFlags.doHeapProfile = 0;
	    return;
	}
280
281
282
283
284
285
    }
}

void
initTimeProfiling(void)
{
286
287
    /* Start ticking */
    startProfTimer();
288
289
290
291
292
};

void 
endProfiling ( void )
{
293
294
295
296
297
298
    if (RtsFlags.CcFlags.doCostCentres) {
        stopProfTimer();
    }
    if (RtsFlags.ProfFlags.doHeapProfile) {
        endHeapProfiling();
    }
299
300
301
}

/* -----------------------------------------------------------------------------
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
   Set CCCS when entering a function.

   The algorithm is as follows.

     ccs ++> ccsfn  =  ccs ++ dropCommonPrefix ccs ccsfn

   where

     dropCommonPrefix A B
        -- returns the suffix of B after removing any prefix common
        -- to both A and B.

   e.g.

     <a,b,c> ++> <>      = <a,b,c>
     <a,b,c> ++> <d>     = <a,b,c,d>
     <a,b,c> ++> <a,b>   = <a,b,c>
     <a,b>   ++> <a,b,c> = <a,b,c>
     <a,b,c> ++> <a,b,d> = <a,b,c,d>

322
323
   -------------------------------------------------------------------------- */

324
325
// implements  c1 ++> c2,  where c1 and c2 are equal depth
//
326
327
328
329
static CostCentreStack *
enterFunEqualStacks (CostCentreStack *ccs0,
                     CostCentreStack *ccsapp,
                     CostCentreStack *ccsfn)
330
{
331
332
333
334
335
336
    ASSERT(ccsapp->depth == ccsfn->depth);
    if (ccsapp == ccsfn) return ccs0;
    return pushCostCentre(enterFunEqualStacks(ccs0,
                                              ccsapp->prevStack,
                                              ccsfn->prevStack),
                          ccsfn->cc);
337
338
339
340
341
342
343
}

// implements  c1 ++> c2,  where c2 is deeper than c1.
// Drop elements of c2 until we have equal stacks, call
// enterFunEqualStacks(), and then push on the elements that we
// dropped in reverse order.
//
344
345
static CostCentreStack *
enterFunCurShorter (CostCentreStack *ccsapp, CostCentreStack *ccsfn, StgWord n)
346
347
{
    if (n == 0) {
348
349
350
351
352
353
        ASSERT(ccsfn->depth == ccsapp->depth);
        return enterFunEqualStacks(ccsapp,ccsapp,ccsfn);;
    } else {
        ASSERT(ccsfn->depth > ccsapp->depth);
        return pushCostCentre(enterFunCurShorter(ccsapp, ccsfn->prevStack, n-1),
                              ccsfn->cc);
354
355
356
    }
}

357
void enterFunCCS (StgRegTable *reg, CostCentreStack *ccsfn)
358
{
359
360
    CostCentreStack *ccsapp;

361
    // common case 1: both stacks are the same
362
    if (ccsfn == reg->rCCCS) {
363
364
365
366
367
368
369
370
        return;
    }

    // common case 2: the function stack is empty, or just CAF
    if (ccsfn->prevStack == CCS_MAIN) {
        return;
    }

371
372
373
    ccsapp = reg->rCCCS;
    reg->rCCCS = CCS_OVERHEAD;

374
375
376
    // common case 3: the stacks are completely different (e.g. one is a
    // descendent of MAIN and the other of a CAF): we append the whole
    // of the function stack to the current CCS.
377
378
    if (ccsfn->root != ccsapp->root) {
        reg->rCCCS = appendCCS(ccsapp,ccsfn);
379
380
381
        return;
    }

382
383
    // uncommon case 4: ccsapp is deeper than ccsfn
    if (ccsapp->depth > ccsfn->depth) {
384
        nat i, n;
385
386
        CostCentreStack *tmp = ccsapp;
        n = ccsapp->depth - ccsfn->depth;
387
388
389
        for (i = 0; i < n; i++) {
            tmp = tmp->prevStack;
        }
390
        reg->rCCCS = enterFunEqualStacks(ccsapp,tmp,ccsfn);
391
392
393
394
        return;
    }

    // uncommon case 5: ccsfn is deeper than CCCS
395
396
397
    if (ccsfn->depth > ccsapp->depth) {
        reg->rCCCS = enterFunCurShorter(ccsapp, ccsfn,
                                        ccsfn->depth - ccsapp->depth);
398
399
        return;
    }
400

401
    // uncommon case 6: stacks are equal depth, but different
402
    reg->rCCCS = enterFunEqualStacks(ccsapp,ccsapp,ccsfn);
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
}

/* -----------------------------------------------------------------------------
   Decide whether closures with this CCS should contribute to the heap
   profile.
   -------------------------------------------------------------------------- */

static void
ccsSetSelected (CostCentreStack *ccs)
{
    if (RtsFlags.ProfFlags.modSelector) {
        if (! strMatchesSelector (ccs->cc->module,
                                  RtsFlags.ProfFlags.modSelector) ) {
	    ccs->selected = 0;
            return;
        }
    }
    if (RtsFlags.ProfFlags.ccSelector) {
        if (! strMatchesSelector (ccs->cc->label,
                                  RtsFlags.ProfFlags.ccSelector) ) {
	    ccs->selected = 0;
            return;
        }
    }
    if (RtsFlags.ProfFlags.ccsSelector) {
	CostCentreStack *c;
        for (c = ccs; c != NULL; c = c->prevStack)
        {
            if ( strMatchesSelector (c->cc->label,
                                     RtsFlags.ProfFlags.ccsSelector) ) {
		break; 
	    }
	}
        if (c == NULL) {
            ccs->selected = 0;
            return;
        }
    }

    ccs->selected = 1;
    return;
444
445
}

446
447
448
449
/* -----------------------------------------------------------------------------
   Cost-centre stack manipulation
   -------------------------------------------------------------------------- */

450
#ifdef DEBUG
451
CostCentreStack * _pushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
452
CostCentreStack *
453
454
pushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
#define pushCostCentre _pushCostCentre
455
{
Simon Marlow's avatar
Simon Marlow committed
456
457
458
459
460
    IF_DEBUG(prof,
	     traceBegin("pushing %s on ", cc->label);
	     debugCCS(ccs);
	     traceEnd(););
	     
461
    return pushCostCentre(ccs,cc);
462
463
464
465
466
467
}
#endif

/* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */

#ifdef DEBUG
468
CostCentreStack *_appendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
469
CostCentreStack *
470
471
472
473
474
475
476
477
478
479
480
appendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
#define appendCCS _appendCCS
{
  IF_DEBUG(prof,
          if (ccs1 != ccs2) {
            debugBelch("Appending ");
            debugCCS(ccs1);
            debugBelch(" to ");
            debugCCS(ccs2);
            debugBelch("\n");});
  return appendCCS(ccs1,ccs2);
481
482
483
484
}
#endif

CostCentreStack *
485
appendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
486
{
487
488
489
490
491
492
493
494
    if (ccs1 == ccs2) {
        return ccs1;
    }

    if (ccs2 == CCS_MAIN || ccs2->cc->is_caf == CC_IS_CAF) {
        // stop at a CAF element
        return ccs1;
    }
495

496
497
    return pushCostCentre(appendCCS(ccs1, ccs2->prevStack), ccs2->cc);
}
498

499
500
501
// Pick one:
// #define RECURSION_DROPS
#define RECURSION_TRUNCATES
502

503
504
505
CostCentreStack *
pushCostCentre (CostCentreStack *ccs, CostCentre *cc)
{
506
507
508
509
510
511
512
513
514
515
    CostCentreStack *temp_ccs, *ret;
    IndexTable *ixtable;

    if (ccs == EMPTY_STACK) {
        ACQUIRE_LOCK(&ccs_mutex);
        ret = actualPush(ccs,cc);
    }
    else
    {
        if (ccs->cc == cc) {
516
            return ccs;
517
        } else {
518
            // check if we've already memoized this stack
519
520
            ixtable = ccs->indexTable;
            temp_ccs = isInIndexTable(ixtable,cc);
521
      
522
            if (temp_ccs != EMPTY_STACK) {
523
                return temp_ccs;
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
            } else {

                // not in the IndexTable, now we take the lock:
                ACQUIRE_LOCK(&ccs_mutex);

                if (ccs->indexTable != ixtable)
                {
                    // someone modified ccs->indexTable while
                    // we did not hold the lock, so we must
                    // check it again:
                    temp_ccs = isInIndexTable(ixtable,cc);
                    if (temp_ccs != EMPTY_STACK)
                    {
                        RELEASE_LOCK(&ccs_mutex);
                        return temp_ccs;
                    }
                }
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
                temp_ccs = checkLoop(ccs,cc);
                if (temp_ccs != NULL) {
                    // This CC is already in the stack somewhere.
                    // This could be recursion, or just calling
                    // another function with the same CC.
                    // A number of policies are possible at this
                    // point, we implement two here:
                    //   - truncate the stack to the previous instance
                    //     of this CC
                    //   - ignore this push, return the same stack.
                    //
                    CostCentreStack *new_ccs;
#if defined(RECURSION_TRUNCATES)
                    new_ccs = temp_ccs;
#else // defined(RECURSION_DROPS)
                    new_ccs = ccs;
#endif
                    ccs->indexTable = addToIndexTable (ccs->indexTable,
                                                       new_ccs, cc, 1);
560
                    ret = new_ccs;
561
                } else {
562
                    ret = actualPush (ccs,cc);
563
564
565
566
                }
            }
        }
    }
567
568
569

    RELEASE_LOCK(&ccs_mutex);
    return ret;
570
}
571

572
static CostCentreStack *
573
checkLoop (CostCentreStack *ccs, CostCentre *cc)
574
{
575
576
577
578
579
580
    while (ccs != EMPTY_STACK) {
        if (ccs->cc == cc)
            return ccs;
        ccs = ccs->prevStack;
    }
    return NULL;
581
582
583
}

static CostCentreStack *
584
actualPush (CostCentreStack *ccs, CostCentre *cc)
585
{
586
    CostCentreStack *new_ccs;
587

588
589
    // allocate space for a new CostCentreStack
    new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
590

591
    return actualPush_(ccs, cc, new_ccs);
592
593
}

594
static CostCentreStack *
595
actualPush_ (CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs)
596
{
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
    /* assign values to each member of the structure */
    new_ccs->ccsID = CCS_ID++;
    new_ccs->cc = cc;
    new_ccs->prevStack = ccs;
    new_ccs->root = ccs->root;
    new_ccs->depth = ccs->depth + 1;

    new_ccs->indexTable = EMPTY_TABLE;

    /* Initialise the various _scc_ counters to zero
     */
    new_ccs->scc_count        = 0;

    /* Initialize all other stats here.  There should be a quick way
     * that's easily used elsewhere too
     */
    new_ccs->time_ticks = 0;
    new_ccs->mem_alloc = 0;
    new_ccs->inherited_ticks = 0;
    new_ccs->inherited_alloc = 0;

    // Set the selected field.
    ccsSetSelected(new_ccs);

    /* update the memoization table for the parent stack */
    if (ccs != EMPTY_STACK) {
        ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
                                          0/*not a back edge*/);
625
    }
626
627
628

    /* return a pointer to the new stack */
    return new_ccs;
629
630
631
}


632
633
static CostCentreStack *
isInIndexTable(IndexTable *it, CostCentre *cc)
634
{
635
636
637
638
639
640
641
    while (it!=EMPTY_TABLE)
    {
        if (it->cc == cc)
            return it->ccs;
        else
            it = it->next;
    }
642
  
643
644
    /* otherwise we never found it so return EMPTY_TABLE */
    return EMPTY_TABLE;
645
646
647
}


648
649
650
static IndexTable *
addToIndexTable (IndexTable *it, CostCentreStack *new_ccs,
                 CostCentre *cc, unsigned int back_edge)
651
{
652
    IndexTable *new_it;
653

654
655
656
657
658
659
660
    new_it = arenaAlloc(prof_arena, sizeof(IndexTable));

    new_it->cc = cc;
    new_it->ccs = new_ccs;
    new_it->next = it;
    new_it->back_edge = back_edge;
    return new_it;
661
662
}

663
664
665
666
/* -----------------------------------------------------------------------------
   Generating a time & allocation profiling report.
   -------------------------------------------------------------------------- */

667
668
669
670
/* We omit certain system-related CCs and CCSs from the default
 * reports, so as not to cause confusion.
 */
static rtsBool
671
ignoreCC (CostCentre *cc)
672
{
673
674
    if (RtsFlags.CcFlags.doCostCentres < COST_CENTRES_ALL &&
        (   cc == CC_OVERHEAD
675
676
	 || cc == CC_DONT_CARE
	 || cc == CC_GC 
677
678
         || cc == CC_SYSTEM
         || cc == CC_IDLE)) {
679
680
681
682
683
684
685
	return rtsTrue;
    } else {
	return rtsFalse;
    }
}

static rtsBool
686
ignoreCCS (CostCentreStack *ccs)
687
{
688
689
690
691
    if (RtsFlags.CcFlags.doCostCentres < COST_CENTRES_ALL &&
        (   ccs == CCS_OVERHEAD
         || ccs == CCS_DONT_CARE
         || ccs == CCS_GC
692
693
         || ccs == CCS_SYSTEM
         || ccs == CCS_IDLE)) {
694
        return rtsTrue;
695
696
697
698
699
    } else {
	return rtsFalse;
    }
}

700
701
702
703
704
705
706
/* -----------------------------------------------------------------------------
   Generating the aggregated per-cost-centre time/alloc report.
   -------------------------------------------------------------------------- */

static CostCentre *sorted_cc_list;

static void
707
aggregateCCCosts( CostCentreStack *ccs )
708
{
709
    IndexTable *i;
710

711
712
    ccs->cc->mem_alloc += ccs->mem_alloc;
    ccs->cc->time_ticks += ccs->time_ticks;
713

714
715
716
717
    for (i = ccs->indexTable; i != 0; i = i->next) {
        if (!i->back_edge) {
            aggregateCCCosts(i->ccs);
        }
718
    }
719
720
721
}

static void
722
insertCCInSortedList( CostCentre *new_cc )
723
{
724
    CostCentre **prev, *cc;
725

726
727
728
729
730
731
732
733
734
    prev = &sorted_cc_list;
    for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
        if (new_cc->time_ticks > cc->time_ticks) {
            new_cc->link = cc;
            *prev = new_cc;
            return;
        } else {
            prev = &(cc->link);
        }
735
    }
736
737
    new_cc->link = NULL;
    *prev = new_cc;
738
739
}

740
741
742
743
744
745
746
747
748
749
750
751
752
static nat
strlen_utf8 (char *s)
{
    nat n = 0;
    unsigned char c;

    for (; *s != '\0'; s++) {
        c = *s;
        if (c < 0x80 || c > 0xBF) n++;
    }
    return n;
}

753
static void
754
reportPerCCCosts( void )
755
{
756
757
    CostCentre *cc, *next;
    nat max_label_len, max_module_len;
758

759
760
    aggregateCCCosts(CCS_MAIN);
    sorted_cc_list = NULL;
761

762
763
    max_label_len  = 11; // no shorter than the "COST CENTRE" header
    max_module_len = 7;  // no shorter than the "MODULE" header
764

765
766
767
768
769
770
771
    for (cc = CC_LIST; cc != NULL; cc = next) {
        next = cc->link;
        if (cc->time_ticks > total_prof_ticks/100
            || cc->mem_alloc > total_alloc/100
            || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
            insertCCInSortedList(cc);

772
773
            max_label_len = stg_max(strlen_utf8(cc->label), max_label_len);
            max_module_len = stg_max(strlen_utf8(cc->module), max_module_len);
774
        }
775
776
    }

777
778
779
780
781
782
783
784
785
786
787
    fprintf(prof_file, "%-*s %-*s", max_label_len, "COST CENTRE", max_module_len, "MODULE");
    fprintf(prof_file, "%6s %6s", "%time", "%alloc");
    if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
        fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
    }
    fprintf(prof_file, "\n\n");

    for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
        if (ignoreCC(cc)) {
            continue;
        }
788
789
790
791
792
793
        fprintf(prof_file, "%s%*s %s%*s",
                cc->label,
                max_label_len - strlen_utf8(cc->label), "",
                cc->module,
                max_module_len - strlen_utf8(cc->module), "");

794
795
796
797
798
799
800
801
802
803
804
805
806
807
        fprintf(prof_file, "%6.1f %6.1f",
                total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
                total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
                                          total_alloc * 100)
            );

        if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
            fprintf(prof_file, "  %5" FMT_Word64 " %9" FMT_Word64,
                    (StgWord64)(cc->time_ticks), cc->mem_alloc*sizeof(W_));
        }
        fprintf(prof_file, "\n");
    }

    fprintf(prof_file,"\n\n");
808
809
810
811
812
813
814
}

/* -----------------------------------------------------------------------------
   Generate the cost-centre-stack time/alloc report
   -------------------------------------------------------------------------- */

static void 
815
fprintHeader( nat max_label_len, nat max_module_len )
816
{
817
    fprintf(prof_file, "%-*s %-*s%6s %11s  %11s   %11s\n", max_label_len, "", max_module_len, "", "", "", "individual", "inherited");
818

819
820
    fprintf(prof_file, "%-*s %-*s", max_label_len, "COST CENTRE", max_module_len, "MODULE");
    fprintf(prof_file, "%6s %11s  %5s %5s   %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
821

822
823
824
    if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
        fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
    }
825

826
    fprintf(prof_file, "\n\n");
827
828
}

829
void
830
reportCCSProfiling( void )
831
832
833
{
    nat count;
    char temp[128]; /* sigh: magic constant */
834
    
835
836
    stopProfTimer();

837
    total_prof_ticks = 0;
838
    total_alloc = 0;
839
    countTickss(CCS_MAIN);
840
    
841
    if (RtsFlags.CcFlags.doCostCentres == 0) return;
842

843
844
845
846
    fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
	    time_str(), "Final");

    fprintf(prof_file, "\n\t  ");
sof's avatar
sof committed
847
    fprintf(prof_file, " %s", prog_name);
848
849
850
851
852
853
854
855
    fprintf(prof_file, " +RTS");
    for (count = 0; rts_argv[count]; count++)
	fprintf(prof_file, " %s", rts_argv[count]);
    fprintf(prof_file, " -RTS");
    for (count = 1; prog_argv[count]; count++)
	fprintf(prof_file, " %s", prog_argv[count]);
    fprintf(prof_file, "\n\n");

856
    fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d us, %d processor%s)\n",
Simon Marlow's avatar
Simon Marlow committed
857
            ((double) total_prof_ticks *
858
             (double) RtsFlags.MiscFlags.tickInterval) / (TIME_RESOLUTION * n_capabilities),
859
	    (unsigned long) total_prof_ticks,
860
861
            (int) TimeToUS(RtsFlags.MiscFlags.tickInterval),
            n_capabilities, n_capabilities > 1 ? "s" : "");
862
863

    fprintf(prof_file, "\ttotal alloc = %11s bytes",
Ian Lynagh's avatar
Ian Lynagh committed
864
	    showStgWord64(total_alloc * sizeof(W_),
865
866
867
868
				 temp, rtsTrue/*commas*/));

    fprintf(prof_file, "  (excludes profiling overheads)\n\n");

869
    reportPerCCCosts();
870

871
    inheritCosts(CCS_MAIN);
872

873
    reportCCS(pruneCCSTree(CCS_MAIN));
874
875
876
}

static void 
877
findCCSMaxLens(CostCentreStack *ccs, nat indent, nat *max_label_len, nat *max_module_len) {
878
879
880
881
882
    CostCentre *cc;
    IndexTable *i;

    cc = ccs->cc;

883
884
    *max_label_len = stg_max(*max_label_len, indent + strlen_utf8(cc->label));
    *max_module_len = stg_max(*max_module_len, strlen_utf8(cc->module));
885
886
887
888
889

    for (i = ccs->indexTable; i != 0; i = i->next) {
        if (!i->back_edge) {
            findCCSMaxLens(i->ccs, indent+1, max_label_len, max_module_len);
        }
890
891
892
893
894
    }
}

static void 
logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len)
895
{
896
897
    CostCentre *cc;
    IndexTable *i;
898

899
900
901
902
903
904
    cc = ccs->cc;

    /* Only print cost centres with non 0 data ! */

    if (!ignoreCCS(ccs))
        /* force printing of *all* cost centres if -Pa */
905
906
    {

907
908
909
910
911
912
        fprintf(prof_file, "%-*s%s%*s %s%*s",
                indent, "",
                cc->label,
                max_label_len-indent - strlen_utf8(cc->label), "",
                cc->module,
                max_module_len - strlen_utf8(cc->module), "");
913

914
915
916
917
918
919
        fprintf(prof_file, "%6ld %11" FMT_Word64 "  %5.1f  %5.1f   %5.1f  %5.1f",
            ccs->ccsID, ccs->scc_count,
                total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
                total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
                total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
                total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
920
921
	    );

922
923
924
925
926
        if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
            fprintf(prof_file, "  %5" FMT_Word64 " %9" FMT_Word64,
                    (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
        }
        fprintf(prof_file, "\n");
927
928
    }

929
930
931
932
    for (i = ccs->indexTable; i != 0; i = i->next) {
        if (!i->back_edge) {
            logCCS(i->ccs, indent+1, max_label_len, max_module_len);
        }
933
    }
934
935
}

936
937
938
static void
reportCCS(CostCentreStack *ccs)
{
939
940
941
942
943
944
945
946
947
    nat max_label_len, max_module_len;

    max_label_len = 11; // no shorter than "COST CENTRE" header
    max_module_len = 7; // no shorter than "MODULE" header

    findCCSMaxLens(ccs, 0, &max_label_len, &max_module_len);

    fprintHeader(max_label_len, max_module_len);
    logCCS(ccs, 0, max_label_len, max_module_len);
948
949
}

andy's avatar
andy committed
950

951
952
953
954
/* Traverse the cost centre stack tree and accumulate
 * ticks/allocations.
 */
static void
955
countTickss(CostCentreStack *ccs)
956
{
957
958
959
960
961
    IndexTable *i;

    if (!ignoreCCS(ccs)) {
        total_alloc += ccs->mem_alloc;
        total_prof_ticks += ccs->time_ticks;
962
    }
963
964
965
966
    for (i = ccs->indexTable; i != NULL; i = i->next)
        if (!i->back_edge) {
            countTickss(i->ccs);
        }
967
968
}

969
970
971
/* Traverse the cost centre stack tree and inherit ticks & allocs.
 */
static void
972
inheritCosts(CostCentreStack *ccs)
973
{
974
    IndexTable *i;
975

976
    if (ignoreCCS(ccs)) { return; }
977

978
979
    ccs->inherited_ticks += ccs->time_ticks;
    ccs->inherited_alloc += ccs->mem_alloc;
980

981
982
983
984
985
986
987
988
    for (i = ccs->indexTable; i != NULL; i = i->next)
        if (!i->back_edge) {
            inheritCosts(i->ccs);
            ccs->inherited_ticks += i->ccs->inherited_ticks;
            ccs->inherited_alloc += i->ccs->inherited_alloc;
        }

    return;
989
990
}

991
992
993
994
//
// Prune CCSs with zero entries, zero ticks or zero allocation from
// the tree, unless COST_CENTRES_ALL is on.
//
995
static CostCentreStack *
996
pruneCCSTree (CostCentreStack *ccs)
997
{
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
    CostCentreStack *ccs1;
    IndexTable *i, **prev;

    prev = &ccs->indexTable;
    for (i = ccs->indexTable; i != 0; i = i->next) {
        if (i->back_edge) { continue; }

        ccs1 = pruneCCSTree(i->ccs);
        if (ccs1 == NULL) {
            *prev = i->next;
        } else {
            prev = &(i->next);
        }
    }

    if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
          /* force printing of *all* cost centres if -P -P */ )
1015

1016
1017
1018
1019
         || ( ccs->indexTable != 0 )
         || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
        ) {
        return ccs;
1020
    } else {
1021
        return NULL;
1022
1023
1024
    }
}

1025
void
1026
fprintCCS( FILE *f, CostCentreStack *ccs )
1027
{
1028
1029
1030
1031
1032
1033
1034
1035
    fprintf(f,"<");
    for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
        fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
        if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
            fprintf(f,",");
        }
    }
    fprintf(f,">");
1036
1037
}

1038
1039
// Returns: True if the call stack ended with CAF
static rtsBool fprintCallStack (CostCentreStack *ccs)
1040
{
1041
1042
1043
1044
1045
1046
1047
1048
1049
    CostCentreStack *prev;

    fprintf(stderr,"%s.%s", ccs->cc->module, ccs->cc->label);
    prev = ccs->prevStack;
    while (prev && prev != CCS_MAIN) {
        ccs = prev;
        fprintf(stderr, ",\n  called from %s.%s",
                ccs->cc->module, ccs->cc->label);
        prev = ccs->prevStack;
1050
    }
1051
    fprintf(stderr, "\n");
1052

1053
    return (!strncmp(ccs->cc->label, "CAF", 3));
1054
1055
}

1056
1057
/* For calling from .cmm code, where we can't reliably refer to stderr */
void
1058
fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso)
1059
{
1060
1061
1062
1063
1064
1065
1066
    rtsBool is_caf;
    StgPtr frame;
    StgStack *stack;
    CostCentreStack *prev_ccs;
    nat depth = 0;
    const nat MAX_DEPTH = 10; // don't print gigantic chains of stacks

1067
1068
1069
    {
        char *desc;
        StgInfoTable *info;
1070
        info = get_itbl(UNTAG_CLOSURE(exception));
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
        switch (info->type) {
        case CONSTR:
        case CONSTR_1_0:
        case CONSTR_0_1:
        case CONSTR_2_0:
        case CONSTR_1_1:
        case CONSTR_0_2:
        case CONSTR_STATIC:
        case CONSTR_NOCAF_STATIC:
            desc = GET_CON_DESC(itbl_to_con_itbl(info));
1081
1082
            break;
       default:
1083
            desc = closure_type_names[info->type];
1084
            break;
1085
1086
1087
1088
        }
        fprintf(stderr, "*** Exception (reporting due to +RTS -xc): (%s), stack trace: \n  ", desc);
    }

1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
    is_caf = fprintCallStack(ccs);

    // traverse the stack down to the enclosing update frame to
    // find out where this CCS was evaluated from...

    stack = tso->stackobj;
    frame = stack->sp;
    prev_ccs = ccs;

    for (; is_caf && depth < MAX_DEPTH; depth++)
    {
        switch (get_itbl((StgClosure*)frame)->type)
        {
        case UPDATE_FRAME:
            ccs = ((StgUpdateFrame*)frame)->header.prof.ccs;
            frame += sizeofW(StgUpdateFrame);
            if (ccs == CCS_MAIN) {
                goto done;
            }
            if (ccs == prev_ccs) {
                // ignore if this is the same as the previous stack,
                // we're probably in library code and haven't
                // accumulated any more interesting stack items
                // since the last update frame.
                break;
            }
            prev_ccs = ccs;
            fprintf(stderr, "  --> evaluated by: ");
            is_caf = fprintCallStack(ccs);
            break;
        case UNDERFLOW_FRAME:
            stack = ((StgUnderflowFrame*)frame)->next_chunk;
            frame = stack->sp;
            break;
        case STOP_FRAME:
            goto done;
        default:
            frame += stack_frame_sizeW((StgClosure*)frame);
            break;
        }
    }
done:
    return;
1132
1133
}

1134
1135
1136
1137
#ifdef DEBUG
void
debugCCS( CostCentreStack *ccs )
{
1138
1139
1140
1141
1142
1143
1144
1145
    debugBelch("<");
    for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
        debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
        if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
            debugBelch(",");
        }
    }
    debugBelch(">");
1146
}
1147
#endif /* DEBUG */
1148

1149
#endif /* PROFILING */