ghc/runtime/profiling/CostCentre.lc

   1 \section[CostCentre.lc]{Code for Cost Centre Profiling}
   2
   3 \begin{code}
   4 #include "rtsdefs.h"
   5 \end{code}
   6
   7 Only have cost centres if @USE_COST_CENTRES@ defined (by the driver),
   8 or if running CONCURRENT.
   9
  10 \begin{code}
  11 #if defined(USE_COST_CENTRES) || defined(CONCURRENT)
  12 CC_DECLARE(CC_MAIN, "MAIN", "MAIN", "MAIN", CC_IS_BORING,/*not static*/);
  13 CC_DECLARE(CC_GC,   "GC",   "GC",   "GC",   CC_IS_BORING,/*not static*/);
  14
  15 # ifdef GUM
  16 CC_DECLARE(CC_MSG,  "MSG",  "MSG",  "MSG",  CC_IS_BORING,/*not static*/);
  17 CC_DECLARE(CC_IDLE, "IDLE", "IDLE", "IDLE", CC_IS_BORING,/*not static*/);
  18 # endif
  19 \end{code}
  20
  21 The current cost centre. It is initially set to "MAIN" by main.
  22 We have to be careful when doing so, as an initial @SET_CCC(CC_MAIN)@
  23 would try to increment some @sub_scc_count@ of the @CCC@ (nothing!).
  24
  25 \begin{code}
  26 CostCentre CCC; /* _not_ initialised */
  27
  28 #endif /* defined(USE_COST_CENTRES) || defined(CONCURRENT) */
  29 \end{code}
  30
  31 The rest is for real cost centres (not thread activities).
  32
  33 \begin{code}
  34 #if defined(USE_COST_CENTRES) || defined(GUM)
  35 \end{code}
  36 %************************************************************************
  37 %*                                                                      *
  38 \subsection[initial-cost-centres]{Initial Cost Centres}
  39 %*                                                                      *
  40 %************************************************************************
  41
  42 Cost centres which are always required:
  43 \begin{code}
  44 #if defined(USE_COST_CENTRES)
  45
  46 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "MAIN", CC_IS_CAF,/*not static*/);
  47 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      "MAIN", CC_IS_SUBSUMED,/*not static*/);
  48 CC_DECLARE(CC_DONTZuCARE,"DONT_CARE",   "MAIN",      "MAIN", CC_IS_BORING,/*not static*/);
  49 #endif
  50 \end{code}
  51
  52 The list of registered cost centres, initially empty:
  53 \begin{code}
  54 CostCentre Registered_CC = REGISTERED_END;
  55 \end{code}
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection[profiling-arguments]{Profiling RTS Arguments}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 \begin{code}
  64 I_  cc_profiling = 0; /* 0  => not "cc_profiling"
  65                          >1 => do serial time profile
  66                          (other magic meanings, too, apparently) WDP 94/07
  67                       */
  68 char cc_profiling_sort = SORTCC_TIME;
  69 I_  dump_intervals = 0;
  70
  71 /* And for the report ... */
  72 static char prof_filename[STATS_FILENAME_MAXLEN];    /* prof report file name = <program>.prof */
  73 static char **prog_argv_save;
  74 static char **rts_argv_save;
  75
  76 /* And the serial report ... */
  77 static char serial_filename[STATS_FILENAME_MAXLEN];  /* serial time profile file name = <program>.time */
  78 static FILE *serial_file = NULL;           /* serial time profile file */
  79
  80 I_
  81 init_cc_profiling(rts_argc, rts_argv, prog_argv)
  82     I_ rts_argc;
  83     char *rts_argv[], *prog_argv[];
  84 {
  85     I_ arg, ch, error = 0;
  86     I_ prof_req = 0;
  87     char *select_cc = 0;
  88     char *select_mod = 0;
  89     char *select_grp = 0;
  90     char *select_descr = 0;
  91     char *select_type = 0;
  92     char *select_kind = 0;
  93     I_  select_age = 0;
  94     char *left, *right;
  95
  96     prog_argv_save = prog_argv;
  97     rts_argv_save = rts_argv;
  98
  99 #ifdef GUM
 100     sprintf(prof_filename, PROF_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 101 #else
 102     sprintf(prof_filename, PROF_FILENAME_FMT, prog_argv[0]);
 103 #endif
 104
 105     for (arg = 0; arg < rts_argc; arg++) {
 106         if (rts_argv[arg][0] == '-') {
 107             switch (rts_argv[arg][1]) {
 108               case 'P': /* detailed cost centre profiling (time/alloc) */
 109                 cc_profiling++;
 110               case 'p': /* cost centre profiling (time/alloc) */
 111                 cc_profiling++;
 112                 for (ch = 2; rts_argv[arg][ch]; ch++) {
 113                 switch (rts_argv[arg][2]) {
 114                   case SORTCC_LABEL:
 115                   case SORTCC_TIME:
 116                   case SORTCC_ALLOC:
 117                         cc_profiling_sort = rts_argv[arg][ch];
 118                     break;
 119                   default:
 120                     fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]);
 121                     error = 1;
 122                 }}
 123                 break;
 124
 125 #if defined(USE_COST_CENTRES)
 126               case 'h': /* serial heap profile */
 127                 switch (rts_argv[arg][2]) {
 128                   case '\0':
 129                   case CCchar:
 130                     prof_req = HEAP_BY_CC;
 131                     break;
 132                   case MODchar:
 133                     prof_req = HEAP_BY_MOD;
 134                     break;
 135                   case GRPchar:
 136                     prof_req = HEAP_BY_GRP;
 137                     break;
 138                   case DESCRchar:
 139                     prof_req = HEAP_BY_DESCR;
 140                     break;
 141                   case TYPEchar:
 142                     prof_req = HEAP_BY_TYPE;
 143                     break;
 144                   case TIMEchar:
 145                     prof_req = HEAP_BY_TIME;
 146                     if (rts_argv[arg][3]) {
 147                         char *start_str = strchr(rts_argv[arg]+3, ',');
 148                         I_ intervals;
 149                         if (start_str) *start_str = '\0';
 150
 151                         if ((intervals = decode(rts_argv[arg]+3)) != 0) {
 152                             time_intervals = (hash_t) intervals;
 153                             /* ToDo: and what if it *is* zero intervals??? */
 154                         }
 155                         if (start_str) {
 156                             earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
 157                         }
 158                     }
 159                     break;
 160                   default:
 161                     fprintf(stderr, "Invalid heap profile option: %s\n",
 162                             rts_argv[arg]);
 163                     error = 1;
 164                 }
 165                 break;
 166
 167               case 'z': /* size of index tables */
 168                 switch (rts_argv[arg][2]) {
 169                   case CCchar:
 170                     max_cc_no = (hash_t) decode(rts_argv[arg]+3);
 171                     if (max_cc_no == 0) {
 172                         fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
 173                         error = 1;
 174                     }
 175                     break;
 176                   case MODchar:
 177                     max_mod_no = (hash_t) decode(rts_argv[arg]+3);
 178                     if (max_mod_no == 0) {
 179                         fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
 180                         error = 1;
 181                     }
 182                     break;
 183                   case GRPchar:
 184                     max_grp_no = (hash_t) decode(rts_argv[arg]+3);
 185                     if (max_grp_no == 0) {
 186                         fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
 187                         error = 1;
 188                     }
 189                     break;
 190                   case DESCRchar:
 191                     max_descr_no = (hash_t) decode(rts_argv[arg]+3);
 192                     if (max_descr_no == 0) {
 193                         fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
 194                         error = 1;
 195                     }
 196                     break;
 197                   case TYPEchar:
 198                     max_type_no = (hash_t) decode(rts_argv[arg]+3);
 199                     if (max_type_no == 0) {
 200                         fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
 201                         error = 1;
 202                     }
 203                     break;
 204                   default:
 205                     fprintf(stderr, "Invalid index table size option: %s\n",
 206                             rts_argv[arg]);
 207                     error = 1;
 208                 }
 209                 break;
 210
 211               case 'c': /* cost centre label select */
 212               case 'm': /* cost centre module select */
 213               case 'g': /* cost centre group select */
 214               case 'd': /* closure descr select */
 215               case 'y': /* closure type select */
 216               case 'k': /* closure kind select */
 217                 left  = strchr(rts_argv[arg], '{');
 218                 right = strrchr(rts_argv[arg], '}');
 219                 if (! left || ! right ||
 220                         strrchr(rts_argv[arg], '{') != left ||
 221                          strchr(rts_argv[arg], '}') != right) {
 222                     fprintf(stderr, "Invalid heap profiling selection bracketing\n   %s\n", rts_argv[arg]);
 223                     error = 1;
 224                 } else {
 225                     *right = '\0';
 226                     switch (rts_argv[arg][1]) {
 227                       case 'c': /* cost centre label select */
 228                         select_cc = left + 1;
 229                 break;
 230                       case 'm': /* cost centre module select */
 231                         select_mod = left + 1;
 232                         break;
 233                       case 'g': /* cost centre group select */
 234                         select_grp = left + 1;
 235                         break;
 236                       case 'd': /* closure descr select */
 237                         select_descr = left + 1;
 238                         break;
 239                       case 't': /* closure type select */
 240                         select_type = left + 1;
 241                         break;
 242                       case 'k': /* closure kind select */
 243                         select_kind = left + 1;
 244                         break;
 245                 }
 246                 }
 247                 break;
 248
 249               case 'a': /* closure age select */
 250                 select_age = decode(rts_argv[arg]+2);
 251
 252 #endif /* defined(USE_COST_CENTRES) */
 253
 254               case 'i': /* serial profiling -- initial timer interval */
 255                 interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
 256                 if (interval_ticks <= 0)
 257                     interval_ticks = 1;
 258                 break;
 259             }
 260         }
 261     }
 262     if (error) return 1;
 263
 264     /* Now perform any work to initialise profiling ... */
 265
 266     if (cc_profiling || prof_req != HEAP_NO_PROFILING) {
 267
 268         time_profiling++;
 269
 270         /* set dump_intervals: if heap profiling only dump every 10 intervals */
 271         if (prof_req == HEAP_NO_PROFILING) {
 272             dump_intervals = 1;
 273         } else {
 274             dump_intervals = 10;
 275         }
 276
 277         if (cc_profiling > 1) {
 278             /* produce serial time profile */
 279
 280 #ifdef GUM
 281             sprintf(serial_filename, TIME_FILENAME_FMT_GUM, prog_argv[0], thisPE);
 282 #else
 283             sprintf(serial_filename, TIME_FILENAME_FMT, prog_argv[0]);
 284 #endif
 285             if ( (serial_file = fopen(serial_filename,"w")) == NULL ) {
 286                 fprintf(stderr, "Can't open serial time log file %s\n", serial_filename);
 287                 return 1;
 288             }
 289
 290             fprintf(serial_file, "JOB \"%s", prog_argv[0]);
 291             fprintf(serial_file, " +RTS -P -i%4.2f -RTS",
 292                     interval_ticks/(StgFloat)TICK_FREQUENCY);
 293             for(arg = 1; prog_argv[arg]; arg++)
 294                 fprintf(serial_file, " %s", prog_argv[arg]);
 295             fprintf(serial_file, "\"\n");
 296             fprintf(serial_file, "DATE \"%s\"\n", time_str());
 297
 298             fprintf(serial_file, "SAMPLE_UNIT \"seconds\"\n");
 299             fprintf(serial_file, "VALUE_UNIT \"time ticks\"\n");
 300
 301             /* output initial 0 sample */
 302             fprintf(serial_file, "BEGIN_SAMPLE 0.00\n");
 303             fprintf(serial_file, "END_SAMPLE 0.00\n");
 304         }
 305     }
 306
 307 #if defined(USE_COST_CENTRES)
 308     if (heap_profile_init(prof_req, select_cc, select_mod, select_grp,
 309                                     select_descr, select_type, select_kind,
 310                                     select_age, prog_argv))
 311         return 1;
 312 #endif
 313
 314     return 0;
 315 }
 316 \end{code}
 317
 318 Registering the cost centres is done after heap allocated as we use
 319 the area to hold the stack of modules still to register.
 320
 321 \begin{code}
 322 extern P_ heap_space;    /* pointer to the heap space */
 323 StgFunPtr * register_stack;  /* stack of register routines -- heap area used */
 324 extern I_ heap_profiling_req;
 325
 326 EXTFUN(startCcRegisteringWorld);
 327
 328 void
 329 cc_register()
 330 {
 331     REGISTER_CC(CC_MAIN);       /* register cost centre CC_MAIN */
 332     REGISTER_CC(CC_GC);         /* register cost centre CC_GC */
 333
 334 #if defined(GUM)
 335     REGISTER_CC(CC_MSG);        /* register cost centre CC_MSG */
 336     REGISTER_CC(CC_IDLE);       /* register cost centre CC_MSG */
 337 #endif
 338
 339 #if defined(USE_COST_CENTRES)
 340     REGISTER_CC(CC_OVERHEAD);   /* register cost centre CC_OVERHEAD */
 341     REGISTER_CC(CC_DONTZuCARE); /* register cost centre CC_DONT_CARE Right??? ToDo */
 342 #endif
 343
 344     /* as per SET_CCC macro, without the sub_scc_count++ bit */
 345     CCC = (CostCentre)STATIC_CC_REF(CC_MAIN);
 346     CCC->scc_count++;
 347
 348 #if defined(USE_COST_CENTRES)
 349 /*  always register -- if we do not, we get warnings (WDP 94/12) */
 350 /*  if (cc_profiling || heap_profiling_req != HEAP_NO_PROFILING) */
 351
 352     register_stack = (StgFunPtr *) heap_space;
 353     miniInterpret((StgFunPtr) startCcRegisteringWorld);
 354 #endif
 355 }
 356 \end{code}
 357
 358 %************************************************************************
 359 %*                                                                      *
 360 \subsection[cost-centre-profiling]{Cost Centre Profiling Report}
 361 %*                                                                      *
 362 %************************************************************************
 363
 364 \begin{code}
 365
 366 static I_ dump_interval = 0;
 367
 368 void
 369 report_cc_profiling(final)
 370 I_ final;
 371 {
 372     FILE *prof_file;
 373     CostCentre cc;
 374     I_ count;
 375     char temp[32];
 376     W_ total_ticks = 0, total_alloc = 0, total_allocs = 0;
 377
 378     if (!cc_profiling)
 379         return;
 380
 381     blockVtAlrmSignal();
 382
 383     if (serial_file) {
 384         StgFloat seconds = (previous_ticks + current_ticks) / (StgFloat) TICK_FREQUENCY;
 385
 386         if (final) {
 387             /* ignore partial sample at end of execution */
 388
 389             /* output final 0 sample */
 390             fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 391             fprintf(serial_file, "END_SAMPLE %0.2f\n", seconds);
 392             fclose(serial_file);
 393             serial_file = NULL;
 394
 395         } else {
 396             /* output serail profile sample */
 397
 398             fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds);
 399
 400             for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
 401                 ASSERT_IS_REGISTERED(cc, 0);
 402                 if (cc->time_ticks) {
 403                     fprintf(serial_file, "  %0.11s:%0.16s %3ld\n",
 404                       cc->module, cc->label, cc->time_ticks);
 405                 }
 406             }
 407
 408             fprintf(serial_file, "END_SAMPLE %0.2f\n", seconds);
 409             fflush(serial_file);
 410         }
 411     }
 412
 413     for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
 414         ASSERT_IS_REGISTERED(cc, 0);
 415         cc->prev_ticks += cc->time_ticks;
 416         cc->time_ticks = 0;
 417
 418         total_ticks  += cc->prev_ticks;
 419         total_alloc  += cc->mem_alloc;
 420         total_allocs += cc->mem_allocs;
 421     }
 422
 423     if (total_ticks != current_ticks + previous_ticks)
 424         fprintf(stderr, "Warning: Cost Centre tick inconsistency: total=%ld, current=%ld, previous=%ld\n", total_ticks, current_ticks, previous_ticks);
 425
 426     unblockVtAlrmSignal();
 427
 428     /* return if no cc profile required */
 429     if (!final && ++dump_interval < dump_intervals)
 430         return;
 431
 432     /* reset dump_interval -- dump again after dump_intervals */
 433     dump_interval = 0;
 434
 435     /* sort cost centres */
 436     cc_sort(&Registered_CC, cc_profiling_sort);
 437
 438     /* open profiling output file */
 439     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 440         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 441         return;
 442     }
 443     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", time_str(),
 444       final ? "Final" : "PARTIAL");
 445
 446     fprintf(prof_file, "\n\t  ");
 447     fprintf(prof_file, " %s", prog_argv_save[0]);
 448     fprintf(prof_file, " +RTS");
 449     for (count = 0; rts_argv_save[count]; count++)
 450         fprintf(prof_file, " %s", rts_argv_save[count]);
 451     fprintf(prof_file, " -RTS");
 452     for (count = 1; prog_argv_save[count]; count++)
 453         fprintf(prof_file, " %s", prog_argv_save[count]);
 454     fprintf(prof_file, "\n\n");
 455
 456     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 457       total_ticks / (StgFloat) TICK_FREQUENCY, total_ticks, TICK_MILLISECS);
 458     fprintf(prof_file, "\ttotal alloc = %11s bytes  (%lu closures)  (excludes profiling overheads)\n",
 459       ullong_format_string((ullong) total_alloc * sizeof(W_), temp, rtsTrue/*commas*/), total_allocs);
 460     /* ToDo: 64-bit error! */
 461     fprintf(prof_file, "\n");
 462
 463     fprintf(prof_file, "%-16.16s %-11.11s", "COST CENTRE", "MODULE");
 464 /* ToDo:group
 465     fprintf(prof_file, " %-11.11s", "GROUP");
 466 */
 467     fprintf(prof_file, " %5s %5s %6s %6s", "scc", "subcc", "%time", "%alloc");
 468
 469     if (cc_profiling > 1)
 470         fprintf(prof_file, " %11s  %13s %8s %8s %8s (%5s %8s)", "cafcc", "thunks", "funcs", "PAPs", "closures", "ticks", "bytes");
 471     fprintf(prof_file, "\n\n");
 472
 473     for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) {
 474         ASSERT_IS_REGISTERED(cc, 0);
 475
 476         /* Only print cost centres with non 0 data ! */
 477
 478         if (cc->scc_count || cc->sub_scc_count || cc->prev_ticks || cc->mem_alloc
 479             || (cc_profiling > 1
 480                 && (cc->thunk_count || cc->function_count || cc->pap_count
 481                  || cc->cafcc_count || cc->sub_cafcc_count))
 482             || (cc_profiling > 2
 483                 /* print all cost centres if -P -P */ )
 484             ) {
 485
 486             fprintf(prof_file, "%-16.16s %-11.11s", cc->label, cc->module);
 487 /* ToDo:group
 488             fprintf(prof_file, " %-11.11s",cc->group);
 489 */
 490             fprintf(prof_file, " %5ld %5ld  %5.1f  %5.1f",
 491               cc->scc_count, cc->sub_scc_count,
 492               total_ticks == 0 ? 0.0 : (cc->prev_ticks / (StgFloat) total_ticks * 100),
 493               total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat) total_alloc * 100));
 494
 495             if (cc_profiling > 1)
 496                 fprintf(prof_file, " %8ld %-8ld %8ld %8ld %8ld %8ld (%5ld %8ld)",
 497                         cc->cafcc_count, cc->sub_cafcc_count,
 498                         cc->thunk_count, cc->function_count, cc->pap_count,
 499                         cc->mem_allocs,
 500                         cc->prev_ticks, cc->mem_alloc*sizeof(W_));
 501             fprintf(prof_file, "\n");
 502         }
 503     }
 504
 505     fclose(prof_file);
 506 }
 507
 508 \end{code}
 509
 510 %************************************************************************
 511 %*                                                                      *
 512 \subsection[profiling-misc]{Miscellanious Profiling Routines}
 513 %*                                                                      *
 514 %************************************************************************
 515
 516 Routine to sort the list of registered cost centres. Uses a simple
 517 insertion sort. First we need the different comparison routines.
 518
 519 \begin{code}
 520
 521 static I_
 522 cc_lt_label(cc1, cc2)
 523     CostCentre cc1, cc2;
 524 {
 525     I_ cmp;
 526
 527     cmp = strcmp(cc1->group, cc2->group);
 528
 529     if (cmp< 0)
 530         return 1;                                   /* group < */
 531     else if (cmp > 0)
 532         return 0;                                   /* group > */
 533
 534     cmp = strcmp(cc1->module, cc2->module);
 535
 536     if (cmp < 0)
 537         return 1;                                   /* mod < */
 538     else if (cmp > 0)
 539         return 0;                                   /* mod > */
 540
 541     return (strcmp(cc1->label, cc2->label) < 0);    /* cmp labels */
 542 }
 543
 544 static I_
 545 cc_gt_time(cc1, cc2)
 546     CostCentre cc1, cc2;
 547 {
 548     /* ToDo: normal then caf then dict (instead of scc at top) */
 549
 550     if (cc1->scc_count && ! cc2->scc_count)         /* scc counts at top */
 551         return 1;
 552     if (cc2->scc_count && ! cc1->scc_count)         /* scc counts at top */
 553         return 0;
 554
 555     if (cc1->prev_ticks > cc2->prev_ticks)          /* time greater */
 556         return 1;
 557     else if (cc1->prev_ticks < cc2->prev_ticks)     /* time less */
 558         return 0;
 559
 560     if (cc1->mem_alloc > cc2->mem_alloc)            /* time equal; alloc greater */
 561         return 1;
 562     else if (cc1->mem_alloc < cc2->mem_alloc)       /* time equal; alloc less */
 563         return 0;
 564
 565     if (cc1->thunk_count > cc2->thunk_count)        /* time & alloc equal: cmp enters */
 566         return 1;
 567     else if (cc1->thunk_count < cc2->thunk_count)
 568         return 0;
 569
 570     return (cc_lt_label(cc1, cc2));                 /* all data equal: cmp labels */
 571 }
 572
 573 static I_
 574 cc_gt_alloc(cc1, cc2)
 575     CostCentre cc1, cc2;
 576 {
 577     /* ToDo: normal then caf then dict (instead of scc at top) */
 578
 579     if (cc1->scc_count && ! cc2->scc_count)         /* scc counts at top */
 580         return 1;
 581     if (cc2->scc_count && ! cc1->scc_count)         /* scc counts at top */
 582         return 0;
 583
 584     if (cc1->mem_alloc > cc2->mem_alloc)            /* alloc greater */
 585         return 1;
 586     else if (cc1->mem_alloc < cc2->mem_alloc)       /* alloc less */
 587         return 0;
 588
 589     if (cc1->prev_ticks > cc2->prev_ticks)          /* alloc equal; time greater */
 590         return 1;
 591     else if (cc1->prev_ticks < cc2->prev_ticks)     /* alloc equal; time less */
 592         return 0;
 593
 594     if (cc1->thunk_count > cc2->thunk_count)        /* alloc & time: cmp enters */
 595         return 1;
 596     else if (cc1->thunk_count < cc2->thunk_count)
 597         return 0;
 598
 599     return (cc_lt_label(cc1, cc2));                 /* all data equal: cmp labels */
 600 }
 601
 602 #ifdef __STDC__
 603 void
 604 cc_sort(CostCentre *sort, char sort_on)
 605 #else
 606 void
 607 cc_sort(sort, sort_on)
 608     CostCentre *sort;
 609     char sort_on;
 610 #endif
 611 {
 612     I_ (*cc_lt)();
 613     CostCentre sorted, insert, *search, insert_rest;
 614
 615     switch (sort_on) {
 616       case SORTCC_LABEL:
 617         cc_lt = cc_lt_label;
 618         break;
 619       case SORTCC_TIME:
 620         cc_lt = cc_gt_time;
 621         break;
 622       case SORTCC_ALLOC:
 623         cc_lt = cc_gt_alloc;
 624         break;
 625       default:
 626         abort(); /* "can't happen" */
 627     }
 628
 629     sorted = REGISTERED_END;
 630     insert = *sort;
 631
 632     while (insert != REGISTERED_END) {
 633
 634         /* set search to the address of cc required to follow insert */
 635         search = &sorted;
 636         while (*search != REGISTERED_END && (cc_lt)(*search,insert)) {
 637             search = &((*search)->registered);
 638         }
 639
 640         /* place insert at *search and go to next insert */
 641         insert_rest = insert->registered;
 642         insert->registered = *search;
 643         *search = insert;
 644         insert = insert_rest;
 645     }
 646
 647     *sort = sorted;
 648 }
 649 \end{code}
 650
 651 \begin{code}
 652 #endif /* USE_COST_CENTRES || GUM */
 653 \end{code}