1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2001
6 * Retainer set implementation for retainer profiling (see RetainerProfile.c)
8 * ---------------------------------------------------------------------------*/
12 #include "PosixSource.h"
17 #include "RetainerSet.h"
19 #include "Profiling.h"
23 #define HASH_TABLE_SIZE 255
24 #define hash(hk) (hk % HASH_TABLE_SIZE)
25 static RetainerSet *hashTable[HASH_TABLE_SIZE];
27 static Arena *arena; // arena in which we store retainer sets
29 static int nextId; // id of next retainer set
31 /* -----------------------------------------------------------------------------
32 * rs_MANY is a distinguished retainer set, such that
34 * isMember(e, rs_MANY) = True
36 * addElement(e, rs) = rs_MANY, if rs->num >= maxRetainerSetSize
37 * addElement(e, rs_MANY) = rs_MANY
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 = {
50 /* -----------------------------------------------------------------------------
51 * calculate the size of a RetainerSet structure
52 * -------------------------------------------------------------------------- */
54 sizeofRetainerSet( int elems )
56 return (sizeof(RetainerSet) + elems * sizeof(retainer));
59 /* -----------------------------------------------------------------------------
60 * Creates the first pool and initializes hashTable[].
61 * Frees all pools if any.
62 * -------------------------------------------------------------------------- */
64 initializeAllRetainerSet(void)
70 for (i = 0; i < HASH_TABLE_SIZE; i++)
72 nextId = 2; // Initial value must be positive, 2 is MANY.
75 /* -----------------------------------------------------------------------------
76 * Refreshes all pools for reuse and initializes hashTable[].
77 * -------------------------------------------------------------------------- */
79 refreshAllRetainerSet(void)
84 // first approach: completely refresh
88 for (i = 0; i < HASH_TABLE_SIZE; i++)
91 #endif /* FIRST_APPROACH */
94 /* -----------------------------------------------------------------------------
96 * -------------------------------------------------------------------------- */
98 closeAllRetainerSet(void)
103 /* -----------------------------------------------------------------------------
104 * Finds or creates if needed a singleton retainer set.
105 * -------------------------------------------------------------------------- */
107 singleton(retainer r)
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
117 rs = arenaAlloc( arena, sizeofRetainerSet(1) );
120 rs->link = hashTable[hash(hk)];
124 // The new retainer set is placed at the head of the linked list.
125 hashTable[hash(hk)] = rs;
130 /* -----------------------------------------------------------------------------
131 * Finds or creates a retainer set *rs augmented with r.
133 * r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse.
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 * -------------------------------------------------------------------------- */
141 addElement(retainer r, RetainerSet *rs)
144 nat nl; // Number of retainers in *rs Less than r
145 RetainerSet *nrs; // New Retainer Set
146 StgWord hk; // Hash Key
148 #ifdef DEBUG_RETAINER
149 // debugBelch("addElement(%p, %p) = ", r, rs);
153 ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
155 if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
159 ASSERT(!isMember(r, rs));
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.
168 hk = hashKeyAddElement(r, rs);
169 for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
170 // test *rs and *nrs for equality
173 if (rs->num + 1 != nrs->num) continue;
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;
181 if (r != nrs->element[i]) continue; // i == nl
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;
188 #ifdef DEBUG_RETAINER
189 // debugBelch("%p\n", nrs);
191 // The set we are seeking already exists!
195 // create a new retainer set
196 nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
197 nrs->num = rs->num + 1;
199 nrs->link = hashTable[hash(hk)];
201 for (i = 0; i < nl; i++) { // copy the first nl retainers
202 nrs->element[i] = rs->element[i];
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];
209 hashTable[hash(hk)] = nrs;
211 #ifdef DEBUG_RETAINER
212 // debugBelch("%p\n", nrs);
217 /* -----------------------------------------------------------------------------
218 * Call f() for each retainer set.
219 * -------------------------------------------------------------------------- */
221 traverseAllRetainerSet(void (*f)(RetainerSet *))
227 for (i = 0; i < HASH_TABLE_SIZE; i++)
228 for (rs = hashTable[i]; rs != NULL; rs = rs->link)
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
240 printRetainer(FILE *f, retainer itbl)
242 fprintf(f, "%s[%s]", GET_PROF_DESC(itbl), itbl->prof.closure_type);
244 #elif defined(RETAINER_SCHEME_CCS)
245 // Retainer scheme 2: retainer = cost centre stack
247 printRetainer(FILE *f, retainer ccs)
251 #elif defined(RETAINER_SCHEME_CC)
252 // Retainer scheme 3: retainer = cost centre
254 printRetainer(FILE *f, retainer cc)
256 fprintf(f,"%s.%s", cc->module, cc->label);
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
268 printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
270 char tmp[max_length + 1];
276 tmp[max_length] = '\0';
278 // No blank characters are allowed.
279 sprintf(tmp + 0, "(%d)", -(rs->id));
281 ASSERT(size < max_length);
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);
287 if (size == max_length)
289 strncpy(tmp + size, ",", max_length - size);
291 if (size == max_length)
295 strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
296 // size = strlen(tmp);
301 #elif defined(RETAINER_SCHEME_CC)
302 // Retainer scheme 3: retainer = cost centre
304 printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
306 char tmp[max_length + 1];
311 #elif defined(RETAINER_SCHEME_CCS)
312 // Retainer scheme 2: retainer = cost centre stack
314 printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
316 char tmp[max_length + 1];
322 tmp[max_length] = '\0';
324 // No blank characters are allowed.
325 sprintf(tmp + 0, "(%d)", -(rs->id));
327 ASSERT(size < max_length);
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);
333 if (size == max_length)
335 strncpy(tmp + size, ",", max_length - size);
337 if (size == max_length)
341 strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
342 // size = strlen(tmp);
347 #elif defined(RETAINER_SCHEME_CC)
348 // Retainer scheme 3: retainer = cost centre
350 printRetainerSetShort(FILE *f, retainerSet *rs, nat max_length)
352 char tmp[max_length + 1];
358 tmp[max_length] = '\0';
360 // No blank characters are allowed.
361 sprintf(tmp + 0, "(%d)", -(rs->id));
363 ASSERT(size < max_length);
365 for (j = 0; j < rs->num; j++) {
366 if (j < rs->num - 1) {
367 strncpy(tmp + size, rs->element[j]->label,
370 if (size == max_length)
372 strncpy(tmp + size, ",", max_length - size);
374 if (size == max_length)
378 strncpy(tmp + size, rs->element[j]->label,
380 // size = strlen(tmp);
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 ')').
395 // No blank characters are allowed.
396 sprintf(tmp + 0, "(%d)", -(rs->id));
398 ASSERT(size < max_length - DOT_NUMBER);
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, "...");
407 sprintf(tmp + size, "%s,", rs->element[j]->label);
411 if (size + ts > max_length - DOT_NUMBER) {
412 sprintf(tmp + size, "...");
415 sprintf(tmp + size, "%s", rs->element[j]->label);
422 #endif /* RETAINER_SCHEME_CC */
423 #endif /* SECOND_APPROACH */
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
432 outputAllRetainerSet(FILE *prof_file)
436 RetainerSet *rs, **rsArray, *tmp;
438 // find out the number of retainer sets which have had a non-zero cost at
439 // least once during retainer profiling
441 for (i = 0; i < HASH_TABLE_SIZE; i++)
442 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
447 if (numSet == 0) // retainer profiling was not done at all.
451 rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
452 "outputAllRetainerSet()");
454 // prepare for sorting
456 for (i = 0; i < HASH_TABLE_SIZE; i++)
457 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
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) {
472 rsArray[j] = rsArray[j + 1];
473 rsArray[j + 1] = tmp;
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, ", ");
485 printRetainer(prof_file, rsArray[i]->element[j]);
486 fprintf(prof_file, "}\n");
491 #endif /* SECOND_APPROACH */
493 #endif /* PROFILING */