ghc/rts/RetainerSet.c

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