ghc/runtime/profiling/HeapProfile.lc

   1 Only have cost centres etc if @PROFILING@ defined
   2
   3 \begin{code}
   4 /*
   5    Some of the code in here is pretty hairy for the compiler to deal
   6    with after we've swiped all of the useful registers.  I don't believe
   7    any STG registers are live here, but I'm not completely certain.
   8
   9    Any specific routines that require the preservation of caller-saves
  10    STG registers should be pulled out into another file and compiled
  11    with the the appropriate register map.  (Presumably one of the GC
  12    register mappings?) --JSM
  13  */
  14
  15 #define NULL_REG_MAP
  16 #include "../storage/SMinternal.h" /* for ???? */
  17
  18 #if defined (PROFILING)
  19 \end{code}
  20
  21 %************************************************************************
  22 %*                                                                      *
  23 \subsection[heap-profiling]{Heap Profiling}
  24 %*                                                                      *
  25 %************************************************************************
  26
  27 The heap profiling reports the amount of heap space occupied by live
  28 closures pressent in the heap during a garbage collection. This
  29 profile may be broken down in a number of ways:
  30 \begin{itemize}
  31 \item {\bf Cost Centre:} The cost centres responsible for building the
  32 various closures in the heap.
  33 \item {\bf Module:} Aggregation of all the cost centres declared in a module.
  34 \item {\bf Group:}  Aggregation of all the cost centres declared in a group.
  35 \item {\bf Closure Description:} The heap occupied by closures with a particular description (normally the data constructor).
  36 \item {\bf Type Description:} The heap occupied by closures with a particular type (normally the type constructor).
  37 \item {\bf Production time stamp:} The heap occupied by closures of produced during a particular time interval.
  38 \end{itemize}
  39
  40 Relevant closures may be selected by the Cost Centre (label, module
  41 and group), by Closure Category (description, type, and kind) and/or
  42 by age.  A cost centre will be selected if its label, module or group
  43 is selected (default is all). A closure category will be selected if
  44 its description, type or kind is selected (default is all).  A closure
  45 will be selected if both its cost centre, closure category and age are
  46 selected.
  47
  48 When recording the size of the heap objects the additional profiling
  49 etc words are disregarded. The profiling itself is considered an
  50 idealised process which should not affect the statistics gathered.
  51
  52 \begin{code}
  53 #define MAX_SELECT 10
  54
  55 static char heap_profiling_char[] /* indexed by RTSflags.ProfFlags.doHeapProfile */
  56     = {'?', CCchar, MODchar, GRPchar, DESCRchar, TYPEchar, TIMEchar};
  57
  58 static I_  cc_select = 0;                  /* are we selecting on Cost Centre */
  59 static I_  clcat_select = 0;               /* are we selecting on Closure Category*/
  60
  61 static I_   cc_select_no = 0;
  62 static char *cc_select_strs[MAX_SELECT];
  63 static char *ccmod_select_strs[MAX_SELECT];
  64
  65 static I_   mod_select_no = 0;
  66 static char *mod_select_strs[MAX_SELECT];
  67 static I_   grp_select_no = 0;
  68 static char *grp_select_strs[MAX_SELECT];
  69
  70 static I_   descr_select_no = 0;
  71 static char *descr_select_strs[MAX_SELECT];
  72 static I_   type_select_no = 0;
  73 static char *type_select_strs[MAX_SELECT];
  74 static I_   kind_select_no = 0;
  75 static I_   kind_selected[]    = {0, 0, 0, 0, 0, 0};
  76 static char *kind_select_strs[] = {"","CON","FN","PAP","THK","BH",0};
  77
  78 I_ *resid = 0;  /* residencies indexed by hashed feature */
  79
  80 /* For production times we have a resid table of time_intervals */
  81 /* And a seperate resid counter stuff produced earlier & later  */
  82
  83 I_ resid_earlier = 0;
  84 I_ resid_later = 0;
  85 I_ resid_max = 0;            /* Max residency -- used for aux file */
  86
  87 I_ earlier_ticks = 0;     /* No of earlier ticks grouped together */
  88 hash_t time_intervals = 18;   /* No of time_intervals, also earlier & later */
  89
  90 static hash_t earlier_intervals;     /* No of earlier intervals grouped together + 1*/
  91
  92 hash_t
  93 dummy_index_time(STG_NO_ARGS)
  94 {
  95     return time_intervals;
  96 }
  97
  98 hash_t (* init_index_fns[])() = {
  99     0,
 100     init_index_cc,
 101     init_index_mod,
 102     init_index_grp,
 103     init_index_descr,
 104     init_index_type,
 105     dummy_index_time
 106 };
 107
 108 static char heap_filename[STATS_FILENAME_MAXLEN]; /* heap log file name = <program>.hp */
 109 static FILE *heap_file = NULL;
 110
 111 I_
 112 heap_profile_init(cc_select_str, mod_select_str, grp_select_str,
 113                   descr_select_str, type_select_str, kind_select_str,
 114                   argv)
 115     char *cc_select_str;
 116     char *mod_select_str;
 117     char *grp_select_str;
 118     char *descr_select_str;
 119     char *type_select_str;
 120     char *kind_select_str;
 121     char *argv[];
 122 {
 123     hash_t count, max, first;
 124     W_ heap_prof_style;
 125
 126     if (! RTSflags.ProfFlags.doHeapProfile)
 127         return 0;
 128
 129     /* for now, if using a generational collector and trying
 130         to heap-profile, just force the GC to be used in two-space mode.
 131         WDP 94/07
 132     */
 133 #if defined(GCap) || defined(GCgn)
 134     RTSflags.GcFlags.force2s = rtsTrue;
 135 #endif
 136
 137     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 138
 139     /* process select strings -- will break them into bits */
 140
 141     if (cc_select_str) {
 142         char *comma, *colon;
 143         while (cc_select_str && cc_select_no < MAX_SELECT) {
 144             if ((comma = strchr(cc_select_str, ',')) != 0) {
 145                 *comma = '\0';
 146             }
 147             if ((colon = strchr(cc_select_str, ':')) != 0) {
 148                 *colon = '\0';
 149                 ccmod_select_strs[cc_select_no] = cc_select_str;
 150                 cc_select_strs[cc_select_no++]  = colon + 1;
 151             } else {
 152                 ccmod_select_strs[cc_select_no] = (char *)0;
 153                 cc_select_strs[cc_select_no++]  = cc_select_str;
 154             }
 155             if (comma) {
 156                 cc_select_str = comma + 1;
 157             } else {
 158                 cc_select_str = (char *)0;
 159             }
 160         }
 161         if (cc_select_str && cc_select_no >= MAX_SELECT) {
 162             fprintf(stderr, "heap_profile_init: Too many Cost Centres selected\n   %ld used %s remaining\n",
 163                     cc_select_no, cc_select_str);
 164             return 1;
 165         }
 166         cc_select |= cc_select_no > 0;
 167     }
 168     if (mod_select_str) {
 169         char *comma;
 170         while ((comma = strchr(mod_select_str, ',')) && mod_select_no < MAX_SELECT) {
 171             mod_select_strs[mod_select_no++] = mod_select_str;
 172             *comma = '\0';
 173             mod_select_str = comma + 1;
 174         }
 175         if (mod_select_no < MAX_SELECT) {
 176             mod_select_strs[mod_select_no++] = mod_select_str;
 177         } else {
 178             fprintf(stderr, "heap_profile_init: Too many Modules selected\n   %ld used %s remaining\n",
 179                     mod_select_no, mod_select_str);
 180             return 1;
 181         }
 182         cc_select |= mod_select_no > 0;
 183     }
 184     if (grp_select_str) {
 185         char *comma;
 186         while ((comma = strchr(grp_select_str, ',')) && grp_select_no < MAX_SELECT) {
 187             grp_select_strs[grp_select_no++] = grp_select_str;
 188             *comma = '\0';
 189             grp_select_str = comma + 1;
 190         }
 191         if (grp_select_no < MAX_SELECT) {
 192             grp_select_strs[grp_select_no++] = grp_select_str;
 193         } else {
 194             fprintf(stderr, "heap_profile_init: Too many Groups selected\n   %ld used %s remaining\n",
 195                     grp_select_no, grp_select_str);
 196             return 1;
 197         }
 198         cc_select |= grp_select_no > 0;
 199     }
 200
 201     if (descr_select_str) {
 202         char *comma;
 203         while ((comma = strchr(descr_select_str, ',')) && descr_select_no < MAX_SELECT) {
 204             descr_select_strs[descr_select_no++] = descr_select_str;
 205             *comma = '\0';
 206             descr_select_str = comma + 1;
 207         }
 208         if (descr_select_no < MAX_SELECT) {
 209             descr_select_strs[descr_select_no++] = descr_select_str;
 210         } else {
 211             fprintf(stderr, "heap_profile_init: Too many Closure Descriptions selected\n   %ld used %s remaining\n",
 212                     descr_select_no, descr_select_str);
 213             return 1;
 214         }
 215         clcat_select |= descr_select_no > 0;
 216     }
 217     if (type_select_str) {
 218         char *comma;
 219         while ((comma = strchr(type_select_str, ',')) && type_select_no < MAX_SELECT) {
 220             type_select_strs[type_select_no++] = type_select_str;
 221             *comma = '\0';
 222             type_select_str = comma + 1;
 223         }
 224         if (type_select_no < MAX_SELECT) {
 225             type_select_strs[type_select_no++] = type_select_str;
 226         } else {
 227             fprintf(stderr, "heap_profile_init: Too many Closure Types selected\n   %ld used %s remaining\n",
 228                     type_select_no, type_select_str);
 229             return 1;
 230         }
 231         clcat_select |= type_select_no > 0;
 232     }
 233     if (kind_select_str) {
 234         char *comma;
 235         while ((comma = strchr(kind_select_str, ',')) != 0) {
 236             *comma = '\0';
 237             for (count = 1; kind_select_strs[count]; count++) {
 238                 if (strcmp(kind_select_strs[count],kind_select_str) == 0) {
 239                     kind_selected[count] = 1;
 240                     kind_select_no++;
 241                     break;
 242                 }
 243             }
 244             if (! kind_select_strs[count]) {
 245                 fprintf(stderr, "heap_profile_init: Invalid Kind: %s\n", kind_select_str);
 246                 return 1;
 247             }
 248             kind_select_str = comma + 1;
 249         }
 250         for (count = 1; kind_select_strs[count]; count++) {
 251             if (strcmp(kind_select_strs[count],kind_select_str) == 0) {
 252                 kind_selected[count] = 1;
 253                 kind_select_no++;
 254                 break;
 255             }
 256         }
 257         if (! kind_select_strs[count]) {
 258             fprintf(stderr, "heap_profile_init: Invalid Kind: %s\n", kind_select_str);
 259             return 1;
 260         }
 261         clcat_select |= kind_select_no > 0;
 262     }
 263
 264     /* open heap profiling log file */
 265
 266     sprintf(heap_filename, HP_FILENAME_FMT, argv[0]);
 267     if ( (heap_file = fopen(heap_filename,"w")) == NULL ) {
 268         fprintf(stderr, "Can't open heap log file %s\n", heap_filename);
 269         return 1;
 270     }
 271
 272     /* write start of log file */
 273
 274     fprintf(heap_file, "JOB \"%s", argv[0]);
 275     fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_prof_style]);
 276     if (heap_prof_style == HEAP_BY_TIME) {
 277         fprintf(heap_file, "%ld", time_intervals);
 278         if (earlier_ticks) {
 279             fprintf(heap_file, ",%3.1f",
 280                     earlier_ticks / (StgFloat)TICK_FREQUENCY);
 281         }
 282     }
 283     if (cc_select_no) {
 284         fprintf(heap_file, " -c{%s:%s",
 285                 ccmod_select_strs[0],
 286                 cc_select_strs[0]);
 287         for (count = 1; count < cc_select_no; count++) {
 288             fprintf(heap_file, ",%s:%s",
 289                     ccmod_select_strs[count],
 290                     cc_select_strs[count]);
 291         }
 292         fprintf(heap_file, "}");
 293     }
 294     if (mod_select_no) {
 295         fprintf(heap_file, " -m{%s", mod_select_strs[0]);
 296         for (count = 1; count < mod_select_no; count++)
 297             fprintf(heap_file, ",%s", mod_select_strs[count]);
 298         fprintf(heap_file, "}");
 299     }
 300     if (grp_select_no) {
 301         fprintf(heap_file, " -g{%s", grp_select_strs[0]);
 302         for (count = 1; count < grp_select_no; count++)
 303             fprintf(heap_file, ",%s", grp_select_strs[count]);
 304         fprintf(heap_file, "}");
 305     }
 306     if (descr_select_no) {
 307         fprintf(heap_file, " -d{%s", descr_select_strs[0]);
 308         for (count = 1; count < descr_select_no; count++)
 309             fprintf(heap_file, ",%s", descr_select_strs[count]);
 310         fprintf(heap_file, "}");
 311     }
 312     if (type_select_no) {
 313         fprintf(heap_file, " -t{%s", type_select_strs[0]);
 314         for (count = 1; count < type_select_no; count++)
 315             fprintf(heap_file, ",%s", type_select_strs[count]);
 316         fprintf(heap_file, "}");
 317     }
 318     if (kind_select_no) {
 319         fprintf(heap_file, " -k{");
 320         for (count = 1, first = 1; kind_select_strs[count]; count++)
 321             if (kind_selected[count]) {
 322                 fprintf(heap_file, "%s%s", first?"":",", kind_select_strs[count]);
 323                 first = 0;
 324             }
 325         fprintf(heap_file, "}");
 326     }
 327
 328     fprintf(heap_file, " -i%4.2f -RTS", interval_ticks/(StgFloat)TICK_FREQUENCY);
 329     for(count = 1; argv[count]; count++)
 330         fprintf(heap_file, " %s", argv[count]);
 331     fprintf(heap_file, "\"\n");
 332
 333     fprintf(heap_file, "DATE \"%s\"\n", time_str());
 334
 335     fprintf(heap_file, "SAMPLE_UNIT \"seconds\"\n");
 336     fprintf(heap_file, "VALUE_UNIT \"bytes\"\n");
 337
 338     fprintf(heap_file, "BEGIN_SAMPLE 0.00\n");
 339     fprintf(heap_file, "END_SAMPLE 0.00\n");
 340
 341
 342     /* initialise required heap profiling data structures & hashing */
 343
 344     earlier_intervals = (earlier_ticks / interval_ticks) + 1;
 345     max = (* init_index_fns[heap_prof_style])();
 346     resid = (I_ *) stgMallocBytes(max * sizeof(I_), "heap_profile_init");
 347
 348     for (count = 0; count < max; count++)
 349         resid[count] = 0;
 350
 351     return 0;
 352 }
 353 \end{code}
 354
 355 Cost centre selection is set up before a heap profile by running
 356 through the list of registered cost centres and memoising the
 357 selection in the cost centre record. It is only necessary to memoise
 358 the cost centre selection if a selection profiling function is
 359 being called.
 360
 361 Category selection is determined when each closure is encountered. It
 362 is memoised within the category record. We always have to check that
 363 the memoisation has been done as we do not have a list of categories
 364 we can process before hand.
 365
 366 Age selection is done for every closure -- not memoised.
 367
 368 \begin{code}
 369 void
 370 set_selected_ccs(STG_NO_ARGS)   /* set selection before we profile heap */
 371 {
 372     I_ x;
 373     CostCentre cc;
 374
 375     if (cc_select) {
 376         for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
 377             for (x = 0; ! cc->selected && x < cc_select_no; x++)
 378                 cc->selected = (strcmp(cc->label, cc_select_strs[x]) == 0) &&
 379                                (strcmp(cc->module, ccmod_select_strs[x]) == 0);
 380             for (x = 0; ! cc->selected && x < mod_select_no; x++)
 381                 cc->selected = (strcmp(cc->module, mod_select_strs[x]) == 0);
 382             for (x = 0; ! cc->selected && x < grp_select_no; x++)
 383                 cc->selected = (strcmp(cc->group, grp_select_strs[x]) == 0);
 384         }
 385     } else {
 386         for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered)
 387             cc->selected = 1;      /* true if ! cc_select */
 388     }
 389 }
 390
 391
 392 I_
 393 selected_clcat(ClCategory clcat)
 394 {
 395     I_ x;
 396
 397     if (clcat->selected == -1) {     /* if not memoised check selection */
 398         if (clcat_select) {
 399             clcat->selected = 0;
 400             for (x = 0; ! clcat->selected && x < descr_select_no; x++)
 401                 clcat->selected = (strcmp(clcat->descr, descr_select_strs[x]) == 0);
 402             for (x = 0; ! clcat->selected && x < type_select_no; x++)
 403                 clcat->selected = (strcmp(clcat->type, type_select_strs[x]) == 0);
 404             if (kind_select_no) clcat->selected |= kind_selected[clcat->kind];
 405         } else {
 406             clcat->selected = 1;
 407         }
 408     }
 409     return clcat->selected;          /* return memoised selection */
 410 }
 411 \end{code}
 412
 413
 414 Profiling functions called for each closure. The appropriate function
 415 is stored in @heap_profile_fn@ by @heap_profile_setup@.
 416 @heap_profile_fn@ is called for each live closure by the macros
 417 embedded in the garbage collector. They increment the appropriate
 418 resident space counter by the size of the closure (less any profiling
 419 words).
 420
 421 \begin{code}
 422 #define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - TICKY_FIXED_HDR)
 423
 424 void
 425 profile_closure_none(P_ closure, I_ size)
 426 {
 427     return;
 428 }
 429
 430 void
 431 profile_closure_cc(P_ closure, I_ size)
 432 {
 433     CostCentre cc = (CostCentre) CC_HDR(closure);
 434     resid[index_cc(cc)] += size + NON_PROF_HS;
 435     return;
 436 }
 437
 438 void
 439 profile_closure_cc_select(P_ closure, I_ size)
 440 {
 441     CostCentre cc; ClCategory clcat;
 442
 443     cc = (CostCentre) CC_HDR(closure);
 444     if (! cc->selected)                   /* selection determined before profile */
 445         return;                           /* all selected if ! cc_select         */
 446
 447     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 448     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 449         return;
 450
 451     resid[index_cc(cc)] += size + NON_PROF_HS;
 452     return;
 453 }
 454
 455 void
 456 profile_closure_mod(P_ closure, I_ size)
 457 {
 458     CostCentre cc = (CostCentre) CC_HDR(closure);
 459     resid[index_mod(cc)] += size + NON_PROF_HS;
 460     return;
 461 }
 462
 463 void
 464 profile_closure_mod_select(P_ closure, I_ size)
 465 {
 466     CostCentre cc; ClCategory clcat;
 467
 468     cc = (CostCentre) CC_HDR(closure);
 469     if (! cc->selected)                       /* selection determined before profile */
 470         return;
 471
 472     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 473     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 474         return;
 475
 476     resid[index_mod(cc)] += size + NON_PROF_HS;
 477     return;
 478 }
 479
 480 void
 481 profile_closure_grp(P_ closure, I_ size)
 482 {
 483     CostCentre cc = (CostCentre) CC_HDR(closure);
 484     resid[index_grp(cc)] += size + NON_PROF_HS;
 485     return;
 486 }
 487
 488 void
 489 profile_closure_grp_select(P_ closure, I_ size)
 490 {
 491     CostCentre cc; ClCategory clcat;
 492
 493     cc = (CostCentre) CC_HDR(closure);
 494     if (! cc->selected)                       /* selection determined before profile */
 495         return;
 496
 497     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 498     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 499         return;
 500
 501     resid[index_grp(cc)] += size + NON_PROF_HS;
 502     return;
 503 }
 504
 505 void
 506 profile_closure_descr(P_ closure, I_ size)
 507 {
 508     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 509     resid[index_descr(clcat)] += size + NON_PROF_HS;
 510     return;
 511 }
 512
 513 void
 514 profile_closure_descr_select(P_ closure, I_ size)
 515 {
 516     CostCentre cc; ClCategory clcat;
 517
 518     cc = (CostCentre) CC_HDR(closure);
 519     if (! cc->selected)                     /* selection determined before profile */
 520         return;                             /* all selected if ! cc_select         */
 521
 522     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 523     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 524         return;
 525
 526     resid[index_descr(clcat)] += size + NON_PROF_HS;
 527     return;
 528 }
 529
 530 void
 531 profile_closure_type(P_ closure, I_ size)
 532 {
 533     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 534     resid[index_type(clcat)] += size + NON_PROF_HS;
 535     return;
 536 }
 537
 538 void
 539 profile_closure_type_select(P_ closure, I_ size)
 540 {
 541     CostCentre cc; ClCategory clcat;
 542
 543     cc = (CostCentre) CC_HDR(closure);
 544     if (! cc->selected)                     /* selection determined before profile */
 545         return;                             /* all selected if ! cc_select         */
 546
 547     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 548     if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
 549         return;
 550
 551     resid[index_type(clcat)] += size + NON_PROF_HS;
 552     return;
 553 }
 554
 555 void
 556 profile_closure_time(P_ closure, I_ size)
 557 {
 558     return;
 559 }
 560
 561 void
 562 profile_closure_time_select(P_ closure, I_ size)
 563 {
 564     return;
 565 }
 566 \end{code}
 567
 568 @heap_profile_setup@ is called before garbage collection to initialise
 569 for the profile. It assigns the appropriate closure profiling function
 570 to @heap_profile_fn@ and memoises any cost centre selection. If no
 571 profile is required @profile_closure_none@ is assigned.
 572
 573 On completion of garbage collection @heap_profile_done@ is called. It
 574 produces a heap profile report and resets the residency counts to 0.
 575
 576 \begin{code}
 577
 578 void (* heap_profile_fn) PROTO((P_,I_)) = profile_closure_none;
 579
 580 void (* profiling_fns_select[]) PROTO((P_,I_)) = {
 581     profile_closure_none,
 582     profile_closure_cc_select,
 583     profile_closure_mod_select,
 584     profile_closure_grp_select,
 585     profile_closure_descr_select,
 586     profile_closure_type_select,
 587     profile_closure_time_select
 588 };
 589
 590 void (* profiling_fns[]) PROTO((P_,I_)) = {
 591     profile_closure_none,
 592     profile_closure_cc,
 593     profile_closure_mod,
 594     profile_closure_grp,
 595     profile_closure_descr,
 596     profile_closure_type,
 597     profile_closure_time
 598 };
 599
 600 void
 601 heap_profile_setup(STG_NO_ARGS)      /* called at start of heap profile */
 602 {
 603     W_ heap_prof_style;
 604
 605     if (! RTSflags.ProfFlags.doHeapProfile)
 606         return;
 607
 608     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 609
 610     if (cc_select || clcat_select) {
 611         set_selected_ccs();               /* memoise cc selection */
 612         heap_profile_fn = profiling_fns_select[heap_prof_style];
 613     } else {
 614         heap_profile_fn = profiling_fns[heap_prof_style];
 615     }
 616 }
 617
 618 void
 619 heap_profile_done(STG_NO_ARGS)    /* called at end of heap profile */
 620 {
 621     CostCentre cc;
 622     ClCategory clcat;
 623     hash_t ind, max;
 624     StgFloat seconds;
 625     W_ heap_prof_style;
 626
 627     if (! RTSflags.ProfFlags.doHeapProfile)
 628         return;
 629
 630     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 631     heap_profile_fn = profile_closure_none;
 632
 633     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
 634     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 635
 636     max = (* init_index_fns[heap_prof_style])();
 637
 638     switch (heap_prof_style) {
 639       case HEAP_BY_CC:
 640         for (ind = 0; ind < max; ind++) {
 641             if ((cc = index_cc_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 642                 fprintf(heap_file, "  %0.11s:%0.16s %ld\n", cc->module, cc->label, resid[ind] * sizeof(W_));
 643             }
 644             resid[ind] = 0;
 645         }
 646         break;
 647
 648       case HEAP_BY_MOD:
 649         for (ind = 0; ind < max; ind++) {
 650             if ((cc = index_mod_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 651                 fprintf(heap_file, "  %0.11s %ld\n", cc->module, resid[ind] * sizeof(W_));
 652             }
 653             resid[ind] = 0;
 654         }
 655         break;
 656
 657       case HEAP_BY_GRP:
 658         for (ind = 0; ind < max; ind++) {
 659             if ((cc = index_grp_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 660                 fprintf(heap_file, "  %0.11s %ld\n", cc->group, resid[ind] * sizeof(W_));
 661             }
 662             resid[ind] = 0;
 663         }
 664         break;
 665
 666       case HEAP_BY_DESCR:
 667         for (ind = 0; ind < max; ind++) {
 668             if ((clcat = index_descr_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 669                 fprintf(heap_file, "  %0.28s %ld\n", clcat->descr, resid[ind] * sizeof(W_));
 670             }
 671             resid[ind] = 0;
 672         }
 673         break;
 674
 675       case HEAP_BY_TYPE:
 676         for (ind = 0; ind < max; ind++) {
 677             if ((clcat = index_type_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 678                 fprintf(heap_file, "  %0.28s %ld\n", clcat->type, resid[ind] * sizeof(W_));
 679             }
 680             resid[ind] = 0;
 681         }
 682         break;
 683     }
 684
 685     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
 686     fflush(heap_file);
 687 }
 688
 689 void
 690 heap_profile_finish(STG_NO_ARGS)     /* called at end of execution */
 691 {
 692     StgFloat seconds;
 693
 694     if (! RTSflags.ProfFlags.doHeapProfile)
 695         return;
 696
 697     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
 698     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 699     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
 700     fclose(heap_file);
 701
 702     return;
 703 }
 704 \end{code}
 705
 706 \begin{code}
 707 #endif /* PROFILING */
 708 \end{code}