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