ghc/rts/RetainerSet.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RetainerSet.c,v 1.1 2001/11/22 14:25:12 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 2001
   5  * Author: Sungwoo Park
   6  *
   7  * Retainer set implementation for retainer profiling (see RetainerProfile.c)
   8  *
   9  * ---------------------------------------------------------------------------*/
  10
  11 #ifdef PROFILING
  12
  13 #include "Rts.h"
  14 #include "Stats.h"
  15 #include "RtsUtils.h"
  16 #include "RetainerSet.h"
  17 #include "Arena.h"
  18 #include "Profiling.h"
  19
  20 #include <string.h>
  21
  22 #define HASH_TABLE_SIZE 255
  23 #define hash(hk)  (hk % HASH_TABLE_SIZE)
  24 static RetainerSet *hashTable[HASH_TABLE_SIZE];
  25
  26 static Arena *arena;            // arena in which we store retainer sets
  27
  28 static int nextId;              // id of next retainer set
  29
  30 /* -----------------------------------------------------------------------------
  31  * rs_MANY is a distinguished retainer set, such that
  32  *
  33  *        isMember(e, rs_MANY)   = True
  34  *
  35  *        addElement(e, rs)      = rs_MANY,   if rs->num >= maxRetainerSetSize
  36  *        addElement(e, rs_MANY) = rs_MANY
  37  *
  38  * The point of rs_MANY is to keep the total number of retainer sets
  39  * from growing too large.
  40  * -------------------------------------------------------------------------- */
  41 RetainerSet rs_MANY = {
  42     num : 0,
  43     cost : 0,
  44     hashKey : 0,
  45     link : NULL,
  46     id : 1,
  47     element : {}
  48 };
  49
  50 nat maxRetainerSetSize = 16;
  51
  52 /* -----------------------------------------------------------------------------
  53  * calculate the size of a RetainerSet structure
  54  * -------------------------------------------------------------------------- */
  55 static inline size_t
  56 sizeofRetainerSet( int elems )
  57 {
  58     return (sizeof(RetainerSet) + elems * sizeof(retainer));
  59 }
  60
  61 /* -----------------------------------------------------------------------------
  62  * Creates the first pool and initializes hashTable[].
  63  * Frees all pools if any.
  64  * -------------------------------------------------------------------------- */
  65 void
  66 initializeAllRetainerSet(void)
  67 {
  68     int i;
  69
  70     arena = newArena();
  71
  72     for (i = 0; i < HASH_TABLE_SIZE; i++)
  73         hashTable[i] = NULL;
  74     nextId = 2;   // Initial value must be positive, 2 is MANY.
  75 }
  76
  77 /* -----------------------------------------------------------------------------
  78  * Refreshes all pools for reuse and initializes hashTable[].
  79  * -------------------------------------------------------------------------- */
  80 void
  81 refreshAllRetainerSet(void)
  82 {
  83     int i;
  84
  85     // Choose one of the following two approaches.
  86
  87 #ifdef FIRST_APPROACH
  88     // first approach: completely refresh
  89     arenaFree(arena);
  90     arena = newArena();
  91
  92     for (i = 0; i < HASH_TABLE_SIZE; i++)
  93         hashTable[i] = NULL;
  94     nextId = 2;
  95 #endif // FIRST_APPROACH
  96
  97 #ifdef SECOND_APPROACH
  98     // second approach: leave all the retainer sets for reuse
  99     RetainerSet *rs;
 100     for (i = 0;i < HASH_TABLE_SIZE; i++) {
 101         rs = hashTable[i];
 102         while (rs != NULL) {
 103             rs->cost = 0;
 104             rs = rs->link;
 105         }
 106     }
 107     rs_MANY.cost = 0;
 108 #endif // SECOND_APPROACH
 109 }
 110
 111 /* -----------------------------------------------------------------------------
 112  * Frees all pools.
 113  * -------------------------------------------------------------------------- */
 114 void
 115 closeAllRetainerSet(void)
 116 {
 117     arenaFree(arena);
 118 }
 119
 120 /* -----------------------------------------------------------------------------
 121  *  Finds or creates if needed a singleton retainer set.
 122  * -------------------------------------------------------------------------- */
 123 RetainerSet *
 124 singleton(retainer r)
 125 {
 126     RetainerSet *rs;
 127     StgWord hk;
 128
 129     hk = hashKeySingleton(r);
 130     for (rs = hashTable[hash(hk)]; rs != NULL; rs = rs->link)
 131         if (rs->num == 1 &&  rs->element[0] == r) return rs;    // found it
 132
 133     // create it
 134     rs = arenaAlloc( arena, sizeofRetainerSet(1) );
 135     rs->num = 1;
 136     rs->cost = 0;
 137     rs->hashKey = hk;
 138     rs->link = hashTable[hash(hk)];
 139     rs->id = nextId++;
 140     rs->element[0] = r;
 141
 142     // The new retainer set is placed at the head of the linked list.
 143     hashTable[hash(hk)] = rs;
 144
 145     return rs;
 146 }
 147
 148 /* -----------------------------------------------------------------------------
 149  *   Finds or creates a retainer set *rs augmented with r.
 150  *   Invariants:
 151  *     r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse.
 152  *     rs is not NULL.
 153  *   Note:
 154  *     We could check if rs is NULL, in which case this function call
 155  *     reverts to singleton(). We do not choose this strategy because
 156  *     in most cases addElement() is invoked with non-NULL rs.
 157  * -------------------------------------------------------------------------- */
 158 RetainerSet *
 159 addElement(retainer r, RetainerSet *rs)
 160 {
 161     nat i;
 162     nat nl;             // Number of retainers in *rs Less than r
 163     RetainerSet *nrs;   // New Retainer Set
 164     StgWord hk;         // Hash Key
 165
 166 #ifdef DEBUG_RETAINER
 167     // fprintf(stderr, "addElement(%p, %p) = ", r, rs);
 168 #endif
 169
 170     ASSERT(rs != NULL);
 171     ASSERT(rs->num <= maxRetainerSetSize);
 172
 173     if (rs == &rs_MANY || rs->num == maxRetainerSetSize) {
 174         return &rs_MANY;
 175     }
 176
 177     ASSERT(!isMember(r, rs));
 178
 179     for (nl = 0; nl < rs->num; nl++)
 180         if (r < rs->element[nl]) break;
 181     // Now nl is the index for r into the new set.
 182     // Also it denotes the number of retainers less than r in *rs.
 183     // Thus, compare the first nl retainers, then r itself, and finally the
 184     // remaining (rs->num - nl) retainers.
 185
 186     hk = hashKeyAddElement(r, rs);
 187     for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
 188         // test *rs and *nrs for equality
 189
 190         // check their size
 191         if (rs->num + 1 != nrs->num) continue;
 192
 193         // compare the first nl retainers and find the first non-matching one.
 194         for (i = 0; i < nl; i++)
 195             if (rs->element[i] != nrs->element[i]) break;
 196         if (i < nl) continue;
 197
 198         // compare r itself
 199         if (r != nrs->element[i]) continue;       // i == nl
 200
 201         // compare the remaining retainers
 202         for (; i < rs->num; i++)
 203             if (rs->element[i] != nrs->element[i + 1]) break;
 204         if (i < rs->num) continue;
 205
 206 #ifdef DEBUG_RETAINER
 207         // fprintf(stderr, "%p\n", nrs);
 208 #endif
 209         // The set we are seeking already exists!
 210         return nrs;
 211     }
 212
 213     // create a new retainer set
 214     nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
 215     nrs->num = rs->num + 1;
 216     nrs->cost = 0;
 217     nrs->hashKey = hk;
 218     nrs->link = hashTable[hash(hk)];
 219     nrs->id = nextId++;
 220     for (i = 0; i < nl; i++) {              // copy the first nl retainers
 221         nrs->element[i] = rs->element[i];
 222     }
 223     nrs->element[i] = r;                    // copy r
 224     for (; i < rs->num; i++) {              // copy the remaining retainers
 225         nrs->element[i + 1] = rs->element[i];
 226     }
 227
 228     hashTable[hash(hk)] = nrs;
 229
 230 #ifdef DEBUG_RETAINER
 231     // fprintf(stderr, "%p\n", nrs);
 232 #endif
 233     return nrs;
 234 }
 235
 236 /* -----------------------------------------------------------------------------
 237  *  Call f() for each retainer set.
 238  * -------------------------------------------------------------------------- */
 239 void
 240 traverseAllRetainerSet(void (*f)(RetainerSet *))
 241 {
 242     int i;
 243     RetainerSet *rs;
 244
 245     (*f)(&rs_MANY);
 246     for (i = 0; i < HASH_TABLE_SIZE; i++)
 247         for (rs = hashTable[i]; rs != NULL; rs = rs->link)
 248             (*f)(rs);
 249 }
 250
 251
 252 /* -----------------------------------------------------------------------------
 253  *  printRetainer() prints the full information on a given retainer,
 254  *  not a retainer set.
 255  * -------------------------------------------------------------------------- */
 256 #if defined(RETAINER_SCHEME_INFO)
 257 // Retainer scheme 1: retainer = info table
 258 void
 259 printRetainer(FILE *f, retainer itbl)
 260 {
 261     fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type);
 262 }
 263 #elif defined(RETAINER_SCHEME_CCS)
 264 // Retainer scheme 2: retainer = cost centre stack
 265 void
 266 printRetainer(FILE *f, retainer ccs)
 267 {
 268     fprintCCS(f, ccs);
 269 }
 270 #elif defined(RETAINER_SCHEME_CC)
 271 // Retainer scheme 3: retainer = cost centre
 272 void
 273 printRetainer(FILE *f, retainer cc)
 274 {
 275     fprintf(f,"%s.%s", cc->module, cc->label);
 276 }
 277 #endif
 278
 279 /* -----------------------------------------------------------------------------
 280  *  printRetainerSetShort() should always display the same output for
 281  *  a given retainer set regardless of the time of invocation.
 282  * -------------------------------------------------------------------------- */
 283 #ifdef SECOND_APPROACH
 284 #if defined(RETAINER_SCHEME_INFO)
 285 // Retainer scheme 1: retainer = info table
 286 void
 287 printRetainerSetShort(FILE *f, RetainerSet *rs)
 288 {
 289 #define MAX_RETAINER_SET_SPACE  24
 290     char tmp[MAX_RETAINER_SET_SPACE + 1];
 291     int size;
 292     nat j;
 293
 294     ASSERT(rs->id < 0);
 295
 296     tmp[MAX_RETAINER_SET_SPACE] = '\0';
 297
 298     // No blank characters are allowed.
 299     sprintf(tmp + 0, "(%d)", -(rs->id));
 300     size = strlen(tmp);
 301     ASSERT(size < MAX_RETAINER_SET_SPACE);
 302
 303     for (j = 0; j < rs->num; j++) {
 304         if (j < rs->num - 1) {
 305             strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
 306             size = strlen(tmp);
 307             if (size == MAX_RETAINER_SET_SPACE)
 308                 break;
 309             strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
 310             size = strlen(tmp);
 311             if (size == MAX_RETAINER_SET_SPACE)
 312                 break;
 313         }
 314         else {
 315             strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
 316             // size = strlen(tmp);
 317         }
 318     }
 319     fprintf(f, tmp);
 320 }
 321 #elif defined(RETAINER_SCHEME_CC)
 322 // Retainer scheme 3: retainer = cost centre
 323 void
 324 printRetainerSetShort(FILE *f, RetainerSet *rs)
 325 {
 326 #define MAX_RETAINER_SET_SPACE  24
 327     char tmp[MAX_RETAINER_SET_SPACE + 1];
 328     int size;
 329     nat j;
 330
 331 }
 332 #elif defined(RETAINER_SCHEME_CCS)
 333 // Retainer scheme 2: retainer = cost centre stack
 334 void
 335 printRetainerSetShort(FILE *f, RetainerSet *rs)
 336 {
 337 #define MAX_RETAINER_SET_SPACE  24
 338     char tmp[MAX_RETAINER_SET_SPACE + 1];
 339     int size;
 340     nat j;
 341
 342     ASSERT(rs->id < 0);
 343
 344     tmp[MAX_RETAINER_SET_SPACE] = '\0';
 345
 346     // No blank characters are allowed.
 347     sprintf(tmp + 0, "(%d)", -(rs->id));
 348     size = strlen(tmp);
 349     ASSERT(size < MAX_RETAINER_SET_SPACE);
 350
 351     for (j = 0; j < rs->num; j++) {
 352         if (j < rs->num - 1) {
 353             strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
 354             size = strlen(tmp);
 355             if (size == MAX_RETAINER_SET_SPACE)
 356                 break;
 357             strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
 358             size = strlen(tmp);
 359             if (size == MAX_RETAINER_SET_SPACE)
 360                 break;
 361         }
 362         else {
 363             strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
 364             // size = strlen(tmp);
 365         }
 366     }
 367     fprintf(f, tmp);
 368 }
 369 #elif defined(RETAINER_SCHEME_CC)
 370 // Retainer scheme 3: retainer = cost centre
 371 static void
 372 printRetainerSetShort(FILE *f, retainerSet *rs)
 373 {
 374 #define MAX_RETAINER_SET_SPACE  24
 375     char tmp[MAX_RETAINER_SET_SPACE + 1];
 376     int size;
 377     nat j;
 378
 379     ASSERT(rs->id < 0);
 380
 381     tmp[MAX_RETAINER_SET_SPACE] = '\0';
 382
 383     // No blank characters are allowed.
 384     sprintf(tmp + 0, "(%d)", -(rs->id));
 385     size = strlen(tmp);
 386     ASSERT(size < MAX_RETAINER_SET_SPACE);
 387
 388     for (j = 0; j < rs->num; j++) {
 389         if (j < rs->num - 1) {
 390             strncpy(tmp + size, rs->element[j]->label,
 391                     MAX_RETAINER_SET_SPACE - size);
 392             size = strlen(tmp);
 393             if (size == MAX_RETAINER_SET_SPACE)
 394                 break;
 395             strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
 396             size = strlen(tmp);
 397             if (size == MAX_RETAINER_SET_SPACE)
 398                 break;
 399         }
 400         else {
 401             strncpy(tmp + size, rs->element[j]->label,
 402                     MAX_RETAINER_SET_SPACE - size);
 403             // size = strlen(tmp);
 404         }
 405     }
 406     fprintf(f, tmp);
 407 /*
 408   #define MAX_RETAINER_SET_SPACE  24
 409   #define DOT_NUMBER              3
 410   // 1. 32 > MAX_RETAINER_SET_SPACE + 1 (1 for '\0')
 411   // 2. (MAX_RETAINER_SET_SPACE - DOT_NUMBER ) characters should be enough for
 412   //    printing one natural number (plus '(' and ')').
 413   char tmp[32];
 414   int size, ts;
 415   nat j;
 416
 417   ASSERT(rs->id < 0);
 418
 419   // No blank characters are allowed.
 420   sprintf(tmp + 0, "(%d)", -(rs->id));
 421   size = strlen(tmp);
 422   ASSERT(size < MAX_RETAINER_SET_SPACE - DOT_NUMBER);
 423
 424   for (j = 0; j < rs->num; j++) {
 425     ts = strlen(rs->element[j]->label);
 426     if (j < rs->num - 1) {
 427       if (size + ts + 1 > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
 428         sprintf(tmp + size, "...");
 429         break;
 430       }
 431       sprintf(tmp + size, "%s,", rs->element[j]->label);
 432       size += ts + 1;
 433     }
 434     else {
 435       if (size + ts > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
 436         sprintf(tmp + size, "...");
 437         break;
 438       }
 439       sprintf(tmp + size, "%s", rs->element[j]->label);
 440       size += ts;
 441     }
 442   }
 443   fprintf(f, tmp);
 444 */
 445 }
 446 #endif /* RETAINER_SCHEME_CC */
 447 #endif /* SECOND_APPROACH */
 448
 449 /* -----------------------------------------------------------------------------
 450  * Print the statistics.  This function is called after each
 451  * retainer profiling.  *allCost is set the sum of all costs retained
 452  * by any retainer sets.  *numSet is set to the number of all
 453  * retainer sets (including those with 0 cost).
 454  * -------------------------------------------------------------------------- */
 455 void
 456 outputRetainerSet( FILE *hp_file, nat *allCost, nat *numSet )
 457 {
 458     nat i;
 459 #ifdef FIRST_APPROACH
 460     nat j;
 461 #endif
 462     RetainerSet *rs;
 463     double duration;
 464
 465     *allCost = 0;
 466     *numSet = 0;
 467     duration = mut_user_time_during_RP();
 468
 469     fprintf(hp_file, "MARK %f\n", duration);
 470     fprintf(hp_file, "BEGIN_SAMPLE %f\n", duration);
 471
 472     if (rs_MANY.cost > 0) {
 473         fprintf(hp_file, "MANY\t%u\n", rs_MANY.cost * sizeof(StgWord));
 474     }
 475
 476     for (i = 0; i < HASH_TABLE_SIZE; i++) {
 477         for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
 478             (*numSet)++;
 479             /*
 480               Note: If rs->cost is 0, it means that there exists at
 481               least one object which is retained by this retainer set
 482               *rs temporarily.  Since its new retainer set of this
 483               object (replacing *rs) is at least larger than *rs, if
 484               the cost of every object was a positive quantity, the
 485               following invariants would hold: If rs->cost == 0, there
 486               exists a retainer set rs' such that rs'->cost > 0 and
 487               rs'->num > rs->num.  However, static objects cost zero,
 488               this does not hold.  If we set the cost of each static
 489               object to a positive quantity, it should hold, which is
 490               actually the case.
 491             */
 492             if (rs->cost == 0)
 493                 continue;
 494
 495             *allCost += rs->cost;
 496
 497 #ifdef SECOND_APPROACH
 498             if (rs->id > 0)     // if having a positive cost for the first time?
 499                 rs->id = -(rs->id);     // mark as having a positive cost
 500             // Now, this retainer set has a permanent negative id.
 501
 502             // report in the unit of bytes: * sizeof(StgWord)
 503             printRetainerSetShort(hp_file, rs);
 504             fprintf(hp_file, "\t%u\n", rs->cost * sizeof(StgWord));
 505 #endif
 506
 507 #ifdef FIRST_APPROACH
 508             fprintf(hp_file, "{");
 509             for (j = 0; j < rs->num - 1; j++) {
 510                 printRetainer(hp_file, rs->element[j]);
 511                 fprintf(hp_file, ",");
 512             }
 513             printRetainer(hp_file, rs->element[j]);
 514             fprintf(hp_file, "}\t%u\n", rs->cost * sizeof(StgWord));
 515 #endif
 516         }
 517     }
 518     fprintf(hp_file, "END_SAMPLE %f\n", duration);
 519 }
 520
 521 /*
 522   This function is called at the exit of the program.
 523  */
 524 #ifdef SECOND_APPROACH
 525 void
 526 outputAllRetainerSet(FILE *prof_file)
 527 {
 528     nat i, j;
 529     nat numSet;
 530     RetainerSet *rs, **rsArray, *tmp;
 531
 532     // find out the number of retainer sets which have had a non-zero cost at
 533     // least once during retainer profiling
 534     numSet = 0;
 535     for (i = 0; i < HASH_TABLE_SIZE; i++)
 536         for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
 537             if (rs->id < 0)
 538                 numSet++;
 539         }
 540
 541     if (numSet == 0)      // retainer profiling was not done at all.
 542         return;
 543
 544     // allocate memory
 545     rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
 546                              "outputAllRetainerSet()");
 547
 548     // prepare for sorting
 549     j = 0;
 550     for (i = 0; i < HASH_TABLE_SIZE; i++)
 551         for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
 552             if (rs->id < 0) {
 553                 rsArray[j] = rs;
 554                 j++;
 555             }
 556         }
 557
 558     ASSERT(j == numSet);
 559
 560     // sort rsArray[] according to the id of each retainer set
 561     for (i = numSet - 1; i > 0; i--) {
 562         for (j = 0; j <= i - 1; j++) {
 563             // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
 564             if (rsArray[j]->id < rsArray[j + 1]->id) {
 565                 tmp = rsArray[j];
 566                 rsArray[j] = rsArray[j + 1];
 567                 rsArray[j + 1] = tmp;
 568             }
 569         }
 570     }
 571
 572     fprintf(prof_file, "\nRetainer sets created during profiling:\n");
 573     for (i = 0;i < numSet; i++) {
 574         fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
 575         for (j = 0; j < rsArray[i]->num - 1; j++) {
 576             printRetainer(prof_file, rsArray[i]->element[j]);
 577             fprintf(prof_file, ", ");
 578         }
 579         printRetainer(prof_file, rsArray[i]->element[j]);
 580         fprintf(prof_file, "}\n");
 581     }
 582
 583     free(rsArray);
 584 }
 585 #endif // SECOND_APPROACH
 586
 587 #endif /* PROFILING */