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(argv)
 113   char *argv[];
 114 {
 115     char *cc_select_str     = RTSflags.ProfFlags.ccSelector;
 116     char *mod_select_str    = RTSflags.ProfFlags.modSelector;
 117     char *grp_select_str    = RTSflags.ProfFlags.grpSelector;
 118     char *descr_select_str  = RTSflags.ProfFlags.descrSelector;
 119     char *type_select_str   = RTSflags.ProfFlags.typeSelector;
 120     char *kind_select_str   = RTSflags.ProfFlags.kindSelector;
 121
 122     hash_t count, max, first;
 123     W_ heap_prof_style;
 124
 125     if (! RTSflags.ProfFlags.doHeapProfile)
 126         return 0;
 127
 128     /* for now, if using a generational collector and trying
 129         to heap-profile, just force the GC to be used in two-space mode.
 130         WDP 94/07
 131     */
 132 #if defined(GCap) || defined(GCgn)
 133     RTSflags.GcFlags.force2s = rtsTrue;
 134 #endif
 135
 136     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 137
 138     /* process select strings -- will break them into bits */
 139
 140     if (cc_select_str) {
 141         char *comma, *colon;
 142         while (cc_select_str && cc_select_no < MAX_SELECT) {
 143             if ((comma = strchr(cc_select_str, ',')) != 0) {
 144                 *comma = '\0';
 145             }
 146             if ((colon = strchr(cc_select_str, ':')) != 0) {
 147                 *colon = '\0';
 148                 ccmod_select_strs[cc_select_no] = cc_select_str;
 149                 cc_select_strs[cc_select_no++]  = colon + 1;
 150             } else {
 151                 ccmod_select_strs[cc_select_no] = (char *)0;
 152                 cc_select_strs[cc_select_no++]  = cc_select_str;
 153             }
 154             if (comma) {
 155                 cc_select_str = comma + 1;
 156             } else {
 157                 cc_select_str = (char *)0;
 158             }
 159         }
 160         if (cc_select_str && cc_select_no >= MAX_SELECT) {
 161             fprintf(stderr, "heap_profile_init: Too many Cost Centres selected\n   %ld used %s remaining\n",
 162                     cc_select_no, cc_select_str);
 163             return 1;
 164         }
 165         cc_select |= cc_select_no > 0;
 166     }
 167     if (mod_select_str) {
 168         char *comma;
 169         while ((comma = strchr(mod_select_str, ',')) && mod_select_no < MAX_SELECT) {
 170             mod_select_strs[mod_select_no++] = mod_select_str;
 171             *comma = '\0';
 172             mod_select_str = comma + 1;
 173         }
 174         if (mod_select_no < MAX_SELECT) {
 175             mod_select_strs[mod_select_no++] = mod_select_str;
 176         } else {
 177             fprintf(stderr, "heap_profile_init: Too many Modules selected\n   %ld used %s remaining\n",
 178                     mod_select_no, mod_select_str);
 179             return 1;
 180         }
 181         cc_select |= mod_select_no > 0;
 182     }
 183     if (grp_select_str) {
 184         char *comma;
 185         while ((comma = strchr(grp_select_str, ',')) && grp_select_no < MAX_SELECT) {
 186             grp_select_strs[grp_select_no++] = grp_select_str;
 187             *comma = '\0';
 188             grp_select_str = comma + 1;
 189         }
 190         if (grp_select_no < MAX_SELECT) {
 191             grp_select_strs[grp_select_no++] = grp_select_str;
 192         } else {
 193             fprintf(stderr, "heap_profile_init: Too many Groups selected\n   %ld used %s remaining\n",
 194                     grp_select_no, grp_select_str);
 195             return 1;
 196         }
 197         cc_select |= grp_select_no > 0;
 198     }
 199
 200     if (descr_select_str) {
 201         char *comma;
 202         while ((comma = strchr(descr_select_str, ',')) && descr_select_no < MAX_SELECT) {
 203             descr_select_strs[descr_select_no++] = descr_select_str;
 204             *comma = '\0';
 205             descr_select_str = comma + 1;
 206         }
 207         if (descr_select_no < MAX_SELECT) {
 208             descr_select_strs[descr_select_no++] = descr_select_str;
 209         } else {
 210             fprintf(stderr, "heap_profile_init: Too many Closure Descriptions selected\n   %ld used %s remaining\n",
 211                     descr_select_no, descr_select_str);
 212             return 1;
 213         }
 214         clcat_select |= descr_select_no > 0;
 215     }
 216     if (type_select_str) {
 217         char *comma;
 218         while ((comma = strchr(type_select_str, ',')) && type_select_no < MAX_SELECT) {
 219             type_select_strs[type_select_no++] = type_select_str;
 220             *comma = '\0';
 221             type_select_str = comma + 1;
 222         }
 223         if (type_select_no < MAX_SELECT) {
 224             type_select_strs[type_select_no++] = type_select_str;
 225         } else {
 226             fprintf(stderr, "heap_profile_init: Too many Closure Types selected\n   %ld used %s remaining\n",
 227                     type_select_no, type_select_str);
 228             return 1;
 229         }
 230         clcat_select |= type_select_no > 0;
 231     }
 232     if (kind_select_str) {
 233         char *comma;
 234         while ((comma = strchr(kind_select_str, ',')) != 0) {
 235             *comma = '\0';
 236             for (count = 1; kind_select_strs[count]; count++) {
 237                 if (strcmp(kind_select_strs[count],kind_select_str) == 0) {
 238                     kind_selected[count] = 1;
 239                     kind_select_no++;
 240                     break;
 241                 }
 242             }
 243             if (! kind_select_strs[count]) {
 244                 fprintf(stderr, "heap_profile_init: Invalid Kind: %s\n", kind_select_str);
 245                 return 1;
 246             }
 247             kind_select_str = comma + 1;
 248         }
 249         for (count = 1; kind_select_strs[count]; count++) {
 250             if (strcmp(kind_select_strs[count],kind_select_str) == 0) {
 251                 kind_selected[count] = 1;
 252                 kind_select_no++;
 253                 break;
 254             }
 255         }
 256         if (! kind_select_strs[count]) {
 257             fprintf(stderr, "heap_profile_init: Invalid Kind: %s\n", kind_select_str);
 258             return 1;
 259         }
 260         clcat_select |= kind_select_no > 0;
 261     }
 262
 263     /* open heap profiling log file */
 264
 265     sprintf(heap_filename, HP_FILENAME_FMT, argv[0]);
 266     if ( (heap_file = fopen(heap_filename,"w")) == NULL ) {
 267         fprintf(stderr, "Can't open heap log file %s\n", heap_filename);
 268         return 1;
 269     }
 270
 271     /* write start of log file */
 272
 273     fprintf(heap_file, "JOB \"%s", argv[0]);
 274     fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_prof_style]);
 275     if (heap_prof_style == HEAP_BY_TIME) {
 276         fprintf(heap_file, "%ld", time_intervals);
 277         if (earlier_ticks) {
 278             fprintf(heap_file, ",%3.1f",
 279                     earlier_ticks / (StgFloat)TICK_FREQUENCY);
 280         }
 281     }
 282     if (cc_select_no) {
 283         fprintf(heap_file, " -c{%s:%s",
 284                 ccmod_select_strs[0],
 285                 cc_select_strs[0]);
 286         for (count = 1; count < cc_select_no; count++) {
 287             fprintf(heap_file, ",%s:%s",
 288                     ccmod_select_strs[count],
 289                     cc_select_strs[count]);
 290         }
 291         fprintf(heap_file, "}");
 292     }
 293     if (mod_select_no) {
 294         fprintf(heap_file, " -m{%s", mod_select_strs[0]);
 295         for (count = 1; count < mod_select_no; count++)
 296             fprintf(heap_file, ",%s", mod_select_strs[count]);
 297         fprintf(heap_file, "}");
 298     }
 299     if (grp_select_no) {
 300         fprintf(heap_file, " -g{%s", grp_select_strs[0]);
 301         for (count = 1; count < grp_select_no; count++)
 302             fprintf(heap_file, ",%s", grp_select_strs[count]);
 303         fprintf(heap_file, "}");
 304     }
 305     if (descr_select_no) {
 306         fprintf(heap_file, " -d{%s", descr_select_strs[0]);
 307         for (count = 1; count < descr_select_no; count++)
 308             fprintf(heap_file, ",%s", descr_select_strs[count]);
 309         fprintf(heap_file, "}");
 310     }
 311     if (type_select_no) {
 312         fprintf(heap_file, " -y{%s", type_select_strs[0]);
 313         for (count = 1; count < type_select_no; count++)
 314             fprintf(heap_file, ",%s", type_select_strs[count]);
 315         fprintf(heap_file, "}");
 316     }
 317     if (kind_select_no) {
 318         fprintf(heap_file, " -k{");
 319         for (count = 1, first = 1; kind_select_strs[count]; count++)
 320             if (kind_selected[count]) {
 321                 fprintf(heap_file, "%s%s", first?"":",", kind_select_strs[count]);
 322                 first = 0;
 323             }
 324         fprintf(heap_file, "}");
 325     }
 326
 327     fprintf(heap_file, " -i%4.2f -RTS", interval_ticks/(StgFloat)TICK_FREQUENCY);
 328     for(count = 1; argv[count]; count++)
 329         fprintf(heap_file, " %s", argv[count]);
 330     fprintf(heap_file, "\"\n");
 331
 332     fprintf(heap_file, "DATE \"%s\"\n", time_str());
 333
 334     fprintf(heap_file, "SAMPLE_UNIT \"seconds\"\n");
 335     fprintf(heap_file, "VALUE_UNIT \"bytes\"\n");
 336
 337     fprintf(heap_file, "BEGIN_SAMPLE 0.00\n");
 338     fprintf(heap_file, "END_SAMPLE 0.00\n");
 339
 340
 341     /* initialise required heap profiling data structures & hashing */
 342
 343     earlier_intervals = (earlier_ticks / interval_ticks) + 1;
 344     max = (* init_index_fns[heap_prof_style])();
 345     resid = (I_ *) stgMallocBytes(max * sizeof(I_), "heap_profile_init");
 346
 347     for (count = 0; count < max; count++)
 348         resid[count] = 0;
 349
 350     return 0;
 351 }
 352 \end{code}
 353
 354 Cost centre selection is set up before a heap profile by running
 355 through the list of registered cost centres and memoising the
 356 selection in the cost centre record. It is only necessary to memoise
 357 the cost centre selection if a selection profiling function is
 358 being called.
 359
 360 Category selection is determined when each closure is encountered. It
 361 is memoised within the category record. We always have to check that
 362 the memoisation has been done as we do not have a list of categories
 363 we can process before hand.
 364
 365 Age selection is done for every closure -- not memoised.
 366
 367 \begin{code}
 368 void
 369 set_selected_ccs(STG_NO_ARGS)   /* set selection before we profile heap */
 370 {
 371     I_ x;
 372     CostCentre cc;
 373
 374     if (cc_select) {
 375         for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
 376             for (x = 0; ! cc->selected && x < cc_select_no; x++)
 377                 cc->selected = (strcmp(cc->label, cc_select_strs[x]) == 0) &&
 378                                (strcmp(cc->module, ccmod_select_strs[x]) == 0);
 379             for (x = 0; ! cc->selected && x < mod_select_no; x++)
 380                 cc->selected = (strcmp(cc->module, mod_select_strs[x]) == 0);
 381             for (x = 0; ! cc->selected && x < grp_select_no; x++)
 382                 cc->selected = (strcmp(cc->group, grp_select_strs[x]) == 0);
 383         }
 384     } else {
 385         for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered)
 386             cc->selected = 1;      /* true if ! cc_select */
 387     }
 388 }
 389
 390
 391 I_
 392 selected_clcat(ClCategory clcat)
 393 {
 394     I_ x;
 395
 396     if (clcat->selected == -1) {     /* if not memoised check selection */
 397         if (clcat_select) {
 398             clcat->selected = 0;
 399             for (x = 0; ! clcat->selected && x < descr_select_no; x++)
 400                 clcat->selected = (strcmp(clcat->descr, descr_select_strs[x]) == 0);
 401             for (x = 0; ! clcat->selected && x < type_select_no; x++)
 402                 clcat->selected = (strcmp(clcat->type, type_select_strs[x]) == 0);
 403             if (kind_select_no) clcat->selected |= kind_selected[clcat->kind];
 404         } else {
 405             clcat->selected = 1;
 406         }
 407     }
 408     return clcat->selected;          /* return memoised selection */
 409 }
 410 \end{code}
 411
 412
 413 Profiling functions called for each closure. The appropriate function
 414 is stored in @heap_profile_fn@ by @heap_profile_setup@.
 415 @heap_profile_fn@ is called for each live closure by the macros
 416 embedded in the garbage collector. They increment the appropriate
 417 resident space counter by the size of the closure (less any profiling
 418 words).
 419
 420 \begin{code}
 421 #define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - TICKY_FIXED_HDR)
 422
 423 void
 424 profile_closure_cc(P_ closure, I_ size)
 425 {
 426     CostCentre cc = (CostCentre) CC_HDR(closure);
 427     resid[index_cc(cc)] += size + NON_PROF_HS;
 428     return;
 429 }
 430
 431 void
 432 profile_closure_cc_select(P_ closure, I_ size)
 433 {
 434     CostCentre cc; ClCategory clcat;
 435
 436     cc = (CostCentre) CC_HDR(closure);
 437     if (! cc->selected)                   /* selection determined before profile */
 438         return;                           /* all selected if ! cc_select         */
 439
 440     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 441     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 442         return;
 443
 444     resid[index_cc(cc)] += size + NON_PROF_HS;
 445     return;
 446 }
 447
 448 void
 449 profile_closure_mod(P_ closure, I_ size)
 450 {
 451     CostCentre cc = (CostCentre) CC_HDR(closure);
 452     resid[index_mod(cc)] += size + NON_PROF_HS;
 453     return;
 454 }
 455
 456 void
 457 profile_closure_mod_select(P_ closure, I_ size)
 458 {
 459     CostCentre cc; ClCategory clcat;
 460
 461     cc = (CostCentre) CC_HDR(closure);
 462     if (! cc->selected)                       /* selection determined before profile */
 463         return;
 464
 465     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 466     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 467         return;
 468
 469     resid[index_mod(cc)] += size + NON_PROF_HS;
 470     return;
 471 }
 472
 473 void
 474 profile_closure_grp(P_ closure, I_ size)
 475 {
 476     CostCentre cc = (CostCentre) CC_HDR(closure);
 477     resid[index_grp(cc)] += size + NON_PROF_HS;
 478     return;
 479 }
 480
 481 void
 482 profile_closure_grp_select(P_ closure, I_ size)
 483 {
 484     CostCentre cc; ClCategory clcat;
 485
 486     cc = (CostCentre) CC_HDR(closure);
 487     if (! cc->selected)                       /* selection determined before profile */
 488         return;
 489
 490     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 491     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 492         return;
 493
 494     resid[index_grp(cc)] += size + NON_PROF_HS;
 495     return;
 496 }
 497
 498 void
 499 profile_closure_descr(P_ closure, I_ size)
 500 {
 501     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 502     resid[index_descr(clcat)] += size + NON_PROF_HS;
 503     return;
 504 }
 505
 506 void
 507 profile_closure_descr_select(P_ closure, I_ size)
 508 {
 509     CostCentre cc; ClCategory clcat;
 510
 511     cc = (CostCentre) CC_HDR(closure);
 512     if (! cc->selected)                     /* selection determined before profile */
 513         return;                             /* all selected if ! cc_select         */
 514
 515     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 516     if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */
 517         return;
 518
 519     resid[index_descr(clcat)] += size + NON_PROF_HS;
 520     return;
 521 }
 522
 523 void
 524 profile_closure_type(P_ closure, I_ size)
 525 {
 526     ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 527     resid[index_type(clcat)] += size + NON_PROF_HS;
 528     return;
 529 }
 530
 531 void
 532 profile_closure_type_select(P_ closure, I_ size)
 533 {
 534     CostCentre cc; ClCategory clcat;
 535
 536     cc = (CostCentre) CC_HDR(closure);
 537     if (! cc->selected)                     /* selection determined before profile */
 538         return;                             /* all selected if ! cc_select         */
 539
 540     clcat = (ClCategory) INFO_CAT(INFO_PTR(closure));
 541     if (clcat_select && ! selected_clcat(clcat))  /* selection memoised during profile */
 542         return;
 543
 544     resid[index_type(clcat)] += size + NON_PROF_HS;
 545     return;
 546 }
 547
 548 void
 549 profile_closure_time(P_ closure, I_ size)
 550 {
 551     return;
 552 }
 553
 554 void
 555 profile_closure_time_select(P_ closure, I_ size)
 556 {
 557     return;
 558 }
 559 \end{code}
 560
 561 @heap_profile_setup@ is called before garbage collection to initialise
 562 for the profile. It assigns the appropriate closure profiling function
 563 to @heap_profile_fn@ and memoises any cost centre selection. If no
 564 profile is required @heap_profile_fn@ is assigned NULL.
 565
 566 On completion of garbage collection @heap_profile_done@ is called. It
 567 produces a heap profile report and resets the residency counts to 0.
 568
 569 \begin{code}
 570
 571 void (* heap_profile_fn) PROTO((P_,I_)) = NULL;
 572
 573 void (* profiling_fns_select[]) PROTO((P_,I_)) = {
 574     NULL,
 575     profile_closure_cc_select,
 576     profile_closure_mod_select,
 577     profile_closure_grp_select,
 578     profile_closure_descr_select,
 579     profile_closure_type_select,
 580     profile_closure_time_select
 581 };
 582
 583 void (* profiling_fns[]) PROTO((P_,I_)) = {
 584     NULL,
 585     profile_closure_cc,
 586     profile_closure_mod,
 587     profile_closure_grp,
 588     profile_closure_descr,
 589     profile_closure_type,
 590     profile_closure_time
 591 };
 592
 593 void
 594 heap_profile_setup(STG_NO_ARGS)      /* called at start of heap profile */
 595 {
 596     W_ heap_prof_style;
 597
 598     if (! RTSflags.ProfFlags.doHeapProfile)
 599         return;
 600
 601     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 602
 603     if (cc_select || clcat_select) {
 604         set_selected_ccs();               /* memoise cc selection */
 605         heap_profile_fn = profiling_fns_select[heap_prof_style];
 606     } else {
 607         heap_profile_fn = profiling_fns[heap_prof_style];
 608     }
 609 }
 610
 611 void
 612 heap_profile_done(STG_NO_ARGS)    /* called at end of heap profile */
 613 {
 614     CostCentre cc;
 615     ClCategory clcat;
 616     hash_t ind, max;
 617     StgFloat seconds;
 618     W_ heap_prof_style;
 619
 620     if (! RTSflags.ProfFlags.doHeapProfile)
 621         return;
 622
 623     heap_prof_style = RTSflags.ProfFlags.doHeapProfile;
 624     heap_profile_fn = NULL;
 625
 626     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
 627     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 628
 629     max = (* init_index_fns[heap_prof_style])();
 630
 631     switch (heap_prof_style) {
 632       case HEAP_BY_CC:
 633         for (ind = 0; ind < max; ind++) {
 634             if ((cc = index_cc_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 635                 fprintf(heap_file, "  %s:%s %ld\n", cc->module, cc->label, resid[ind] * sizeof(W_));
 636             }
 637             resid[ind] = 0;
 638         }
 639         break;
 640
 641       case HEAP_BY_MOD:
 642         for (ind = 0; ind < max; ind++) {
 643             if ((cc = index_mod_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 644                 fprintf(heap_file, "  %s %ld\n", cc->module, resid[ind] * sizeof(W_));
 645             }
 646             resid[ind] = 0;
 647         }
 648         break;
 649
 650       case HEAP_BY_GRP:
 651         for (ind = 0; ind < max; ind++) {
 652             if ((cc = index_grp_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 653                 fprintf(heap_file, "  %0.11s %ld\n", cc->group, resid[ind] * sizeof(W_));
 654             }
 655             resid[ind] = 0;
 656         }
 657         break;
 658
 659       case HEAP_BY_DESCR:
 660         for (ind = 0; ind < max; ind++) {
 661             if ((clcat = index_descr_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 662                 fprintf(heap_file, "  %0.28s %ld\n", clcat->descr, resid[ind] * sizeof(W_));
 663             }
 664             resid[ind] = 0;
 665         }
 666         break;
 667
 668       case HEAP_BY_TYPE:
 669         for (ind = 0; ind < max; ind++) {
 670             if ((clcat = index_type_table[ind]) != 0 && ! cc_to_ignore(cc)) {
 671                 fprintf(heap_file, "  %0.28s %ld\n", clcat->type, resid[ind] * sizeof(W_));
 672             }
 673             resid[ind] = 0;
 674         }
 675         break;
 676     }
 677
 678     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
 679     fflush(heap_file);
 680 }
 681
 682 void
 683 heap_profile_finish(STG_NO_ARGS)     /* called at end of execution */
 684 {
 685     StgFloat seconds;
 686
 687     if (! RTSflags.ProfFlags.doHeapProfile)
 688         return;
 689
 690     seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY;
 691     fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 692     fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds);
 693     fclose(heap_file);
 694
 695     return;
 696 }
 697 \end{code}
 698
 699 \begin{code}
 700 #endif /* PROFILING */
 701 \end{code}