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 "PosixSource.h"
  13 #include "Rts.h"
  14
  15 #include "Stats.h"
  16 #include "RtsUtils.h"
  17 #include "RetainerSet.h"
  18 #include "Arena.h"
  19 #include "Profiling.h"
  20
  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, nat max_length)
 269 {
 270     char tmp[max_length + 1];
 271     int size;
 272     nat j;
 273
 274     ASSERT(rs->id < 0);
 275
 276     tmp[max_length] = '\0';
 277
 278     // No blank characters are allowed.
 279     sprintf(tmp + 0, "(%d)", -(rs->id));
 280     size = strlen(tmp);
 281     ASSERT(size < max_length);
 282
 283     for (j = 0; j < rs->num; j++) {
 284         if (j < rs->num - 1) {
 285             strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
 286             size = strlen(tmp);
 287             if (size == max_length)
 288                 break;
 289             strncpy(tmp + size, ",", max_length - size);
 290             size = strlen(tmp);
 291             if (size == max_length)
 292                 break;
 293         }
 294         else {
 295             strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
 296             // size = strlen(tmp);
 297         }
 298     }
 299     fprintf(f, tmp);
 300 }
 301 #elif defined(RETAINER_SCHEME_CC)
 302 // Retainer scheme 3: retainer = cost centre
 303 void
 304 printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
 305 {
 306     char tmp[max_length + 1];
 307     int size;
 308     nat j;
 309
 310 }
 311 #elif defined(RETAINER_SCHEME_CCS)
 312 // Retainer scheme 2: retainer = cost centre stack
 313 void
 314 printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
 315 {
 316     char tmp[max_length + 1];
 317     nat size;
 318     nat j;
 319
 320     ASSERT(rs->id < 0);
 321
 322     tmp[max_length] = '\0';
 323
 324     // No blank characters are allowed.
 325     sprintf(tmp + 0, "(%d)", -(rs->id));
 326     size = strlen(tmp);
 327     ASSERT(size < max_length);
 328
 329     for (j = 0; j < rs->num; j++) {
 330         if (j < rs->num - 1) {
 331             strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
 332             size = strlen(tmp);
 333             if (size == max_length)
 334                 break;
 335             strncpy(tmp + size, ",", max_length - size);
 336             size = strlen(tmp);
 337             if (size == max_length)
 338                 break;
 339         }
 340         else {
 341             strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
 342             // size = strlen(tmp);
 343         }
 344     }
 345     fputs(tmp, f);
 346 }
 347 #elif defined(RETAINER_SCHEME_CC)
 348 // Retainer scheme 3: retainer = cost centre
 349 static void
 350 printRetainerSetShort(FILE *f, retainerSet *rs, nat max_length)
 351 {
 352     char tmp[max_length + 1];
 353     int size;
 354     nat j;
 355
 356     ASSERT(rs->id < 0);
 357
 358     tmp[max_length] = '\0';
 359
 360     // No blank characters are allowed.
 361     sprintf(tmp + 0, "(%d)", -(rs->id));
 362     size = strlen(tmp);
 363     ASSERT(size < max_length);
 364
 365     for (j = 0; j < rs->num; j++) {
 366         if (j < rs->num - 1) {
 367             strncpy(tmp + size, rs->element[j]->label,
 368                     max_length - size);
 369             size = strlen(tmp);
 370             if (size == max_length)
 371                 break;
 372             strncpy(tmp + size, ",", max_length - size);
 373             size = strlen(tmp);
 374             if (size == max_length)
 375                 break;
 376         }
 377         else {
 378             strncpy(tmp + size, rs->element[j]->label,
 379                     max_length - size);
 380             // size = strlen(tmp);
 381         }
 382     }
 383     fprintf(f, tmp);
 384 /*
 385   #define DOT_NUMBER              3
 386   // 1. 32 > max_length + 1 (1 for '\0')
 387   // 2. (max_length - DOT_NUMBER ) characters should be enough for
 388   //    printing one natural number (plus '(' and ')').
 389   char tmp[32];
 390   int size, ts;
 391   nat j;
 392
 393   ASSERT(rs->id < 0);
 394
 395   // No blank characters are allowed.
 396   sprintf(tmp + 0, "(%d)", -(rs->id));
 397   size = strlen(tmp);
 398   ASSERT(size < max_length - DOT_NUMBER);
 399
 400   for (j = 0; j < rs->num; j++) {
 401     ts = strlen(rs->element[j]->label);
 402     if (j < rs->num - 1) {
 403       if (size + ts + 1 > max_length - DOT_NUMBER) {
 404         sprintf(tmp + size, "...");
 405         break;
 406       }
 407       sprintf(tmp + size, "%s,", rs->element[j]->label);
 408       size += ts + 1;
 409     }
 410     else {
 411       if (size + ts > max_length - DOT_NUMBER) {
 412         sprintf(tmp + size, "...");
 413         break;
 414       }
 415       sprintf(tmp + size, "%s", rs->element[j]->label);
 416       size += ts;
 417     }
 418   }
 419   fprintf(f, tmp);
 420 */
 421 }
 422 #endif /* RETAINER_SCHEME_CC */
 423 #endif /* SECOND_APPROACH */
 424
 425 /* -----------------------------------------------------------------------------
 426  * Dump the contents of each retainer set into the log file at the end
 427  * of the run, so the user can find out for a given retainer set ID
 428  * the full contents of that set.
 429  * --------------------------------------------------------------------------- */
 430 #ifdef SECOND_APPROACH
 431 void
 432 outputAllRetainerSet(FILE *prof_file)
 433 {
 434     nat i, j;
 435     nat numSet;
 436     RetainerSet *rs, **rsArray, *tmp;
 437
 438     // find out the number of retainer sets which have had a non-zero cost at
 439     // least once during retainer profiling
 440     numSet = 0;
 441     for (i = 0; i < HASH_TABLE_SIZE; i++)
 442         for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
 443             if (rs->id < 0)
 444                 numSet++;
 445         }
 446
 447     if (numSet == 0)      // retainer profiling was not done at all.
 448         return;
 449
 450     // allocate memory
 451     rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
 452                              "outputAllRetainerSet()");
 453
 454     // prepare for sorting
 455     j = 0;
 456     for (i = 0; i < HASH_TABLE_SIZE; i++)
 457         for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
 458             if (rs->id < 0) {
 459                 rsArray[j] = rs;
 460                 j++;
 461             }
 462         }
 463
 464     ASSERT(j == numSet);
 465
 466     // sort rsArray[] according to the id of each retainer set
 467     for (i = numSet - 1; i > 0; i--) {
 468         for (j = 0; j <= i - 1; j++) {
 469             // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
 470             if (rsArray[j]->id < rsArray[j + 1]->id) {
 471                 tmp = rsArray[j];
 472                 rsArray[j] = rsArray[j + 1];
 473                 rsArray[j + 1] = tmp;
 474             }
 475         }
 476     }
 477
 478     fprintf(prof_file, "\nRetainer sets created during profiling:\n");
 479     for (i = 0;i < numSet; i++) {
 480         fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
 481         for (j = 0; j < rsArray[i]->num - 1; j++) {
 482             printRetainer(prof_file, rsArray[i]->element[j]);
 483             fprintf(prof_file, ", ");
 484         }
 485         printRetainer(prof_file, rsArray[i]->element[j]);
 486         fprintf(prof_file, "}\n");
 487     }
 488
 489     stgFree(rsArray);
 490 }
 491 #endif /* SECOND_APPROACH */
 492
 493 #endif /* PROFILING */