rts/RetainerSet.c

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