1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2001
6 * Retainer set implementation for retainer profiling (see RetainerProfile.c)
8 * ---------------------------------------------------------------------------*/
18 #include "RetainerSet.h"
20 #include "Profiling.h"
24 #define HASH_TABLE_SIZE 255
25 #define hash(hk) (hk % HASH_TABLE_SIZE)
26 static RetainerSet *hashTable[HASH_TABLE_SIZE];
28 static Arena *arena; // arena in which we store retainer sets
30 static int nextId; // id of next retainer set
32 /* -----------------------------------------------------------------------------
33 * rs_MANY is a distinguished retainer set, such that
35 * isMember(e, rs_MANY) = True
37 * addElement(e, rs) = rs_MANY, if rs->num >= maxRetainerSetSize
38 * addElement(e, rs_MANY) = rs_MANY
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 = {
51 /* -----------------------------------------------------------------------------
52 * calculate the size of a RetainerSet structure
53 * -------------------------------------------------------------------------- */
55 sizeofRetainerSet( int elems )
57 return (sizeof(RetainerSet) + elems * sizeof(retainer));
60 /* -----------------------------------------------------------------------------
61 * Creates the first pool and initializes hashTable[].
62 * Frees all pools if any.
63 * -------------------------------------------------------------------------- */
65 initializeAllRetainerSet(void)
71 for (i = 0; i < HASH_TABLE_SIZE; i++)
73 nextId = 2; // Initial value must be positive, 2 is MANY.
76 /* -----------------------------------------------------------------------------
77 * Refreshes all pools for reuse and initializes hashTable[].
78 * -------------------------------------------------------------------------- */
80 refreshAllRetainerSet(void)
85 // first approach: completely refresh
89 for (i = 0; i < HASH_TABLE_SIZE; i++)
92 #endif // FIRST_APPROACH
95 /* -----------------------------------------------------------------------------
97 * -------------------------------------------------------------------------- */
99 closeAllRetainerSet(void)
104 /* -----------------------------------------------------------------------------
105 * Finds or creates if needed a singleton retainer set.
106 * -------------------------------------------------------------------------- */
108 singleton(retainer r)
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
118 rs = arenaAlloc( arena, sizeofRetainerSet(1) );
121 rs->link = hashTable[hash(hk)];
125 // The new retainer set is placed at the head of the linked list.
126 hashTable[hash(hk)] = rs;
131 /* -----------------------------------------------------------------------------
132 * Finds or creates a retainer set *rs augmented with r.
134 * r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse.
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 * -------------------------------------------------------------------------- */
142 addElement(retainer r, RetainerSet *rs)
145 nat nl; // Number of retainers in *rs Less than r
146 RetainerSet *nrs; // New Retainer Set
147 StgWord hk; // Hash Key
149 #ifdef DEBUG_RETAINER
150 // debugBelch("addElement(%p, %p) = ", r, rs);
154 ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
156 if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
160 ASSERT(!isMember(r, rs));
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.
169 hk = hashKeyAddElement(r, rs);
170 for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
171 // test *rs and *nrs for equality
174 if (rs->num + 1 != nrs->num) continue;
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;
182 if (r != nrs->element[i]) continue; // i == nl
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;
189 #ifdef DEBUG_RETAINER
190 // debugBelch("%p\n", nrs);
192 // The set we are seeking already exists!
196 // create a new retainer set
197 nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
198 nrs->num = rs->num + 1;
200 nrs->link = hashTable[hash(hk)];
202 for (i = 0; i < nl; i++) { // copy the first nl retainers
203 nrs->element[i] = rs->element[i];
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];
210 hashTable[hash(hk)] = nrs;
212 #ifdef DEBUG_RETAINER
213 // debugBelch("%p\n", nrs);
218 /* -----------------------------------------------------------------------------
219 * Call f() for each retainer set.
220 * -------------------------------------------------------------------------- */
222 traverseAllRetainerSet(void (*f)(RetainerSet *))
228 for (i = 0; i < HASH_TABLE_SIZE; i++)
229 for (rs = hashTable[i]; rs != NULL; rs = rs->link)
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
241 printRetainer(FILE *f, retainer itbl)
243 fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type);
245 #elif defined(RETAINER_SCHEME_CCS)
246 // Retainer scheme 2: retainer = cost centre stack
248 printRetainer(FILE *f, retainer ccs)
252 #elif defined(RETAINER_SCHEME_CC)
253 // Retainer scheme 3: retainer = cost centre
255 printRetainer(FILE *f, retainer cc)
257 fprintf(f,"%s.%s", cc->module, cc->label);
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
269 printRetainerSetShort(FILE *f, RetainerSet *rs)
271 #define MAX_RETAINER_SET_SPACE 24
272 char tmp[MAX_RETAINER_SET_SPACE + 1];
278 tmp[MAX_RETAINER_SET_SPACE] = '\0';
280 // No blank characters are allowed.
281 sprintf(tmp + 0, "(%d)", -(rs->id));
283 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
289 if (size == MAX_RETAINER_SET_SPACE)
291 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
293 if (size == MAX_RETAINER_SET_SPACE)
297 strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
298 // size = strlen(tmp);
303 #elif defined(RETAINER_SCHEME_CC)
304 // Retainer scheme 3: retainer = cost centre
306 printRetainerSetShort(FILE *f, RetainerSet *rs)
308 #define MAX_RETAINER_SET_SPACE 24
309 char tmp[MAX_RETAINER_SET_SPACE + 1];
314 #elif defined(RETAINER_SCHEME_CCS)
315 // Retainer scheme 2: retainer = cost centre stack
317 printRetainerSetShort(FILE *f, RetainerSet *rs)
319 #define MAX_RETAINER_SET_SPACE 24
320 char tmp[MAX_RETAINER_SET_SPACE + 1];
326 tmp[MAX_RETAINER_SET_SPACE] = '\0';
328 // No blank characters are allowed.
329 sprintf(tmp + 0, "(%d)", -(rs->id));
331 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
337 if (size == MAX_RETAINER_SET_SPACE)
339 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
341 if (size == MAX_RETAINER_SET_SPACE)
345 strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
346 // size = strlen(tmp);
351 #elif defined(RETAINER_SCHEME_CC)
352 // Retainer scheme 3: retainer = cost centre
354 printRetainerSetShort(FILE *f, retainerSet *rs)
356 #define MAX_RETAINER_SET_SPACE 24
357 char tmp[MAX_RETAINER_SET_SPACE + 1];
363 tmp[MAX_RETAINER_SET_SPACE] = '\0';
365 // No blank characters are allowed.
366 sprintf(tmp + 0, "(%d)", -(rs->id));
368 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
375 if (size == MAX_RETAINER_SET_SPACE)
377 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
379 if (size == MAX_RETAINER_SET_SPACE)
383 strncpy(tmp + size, rs->element[j]->label,
384 MAX_RETAINER_SET_SPACE - size);
385 // size = strlen(tmp);
390 #define MAX_RETAINER_SET_SPACE 24
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 ')').
401 // No blank characters are allowed.
402 sprintf(tmp + 0, "(%d)", -(rs->id));
404 ASSERT(size < MAX_RETAINER_SET_SPACE - DOT_NUMBER);
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, "...");
413 sprintf(tmp + size, "%s,", rs->element[j]->label);
417 if (size + ts > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
418 sprintf(tmp + size, "...");
421 sprintf(tmp + size, "%s", rs->element[j]->label);
428 #endif /* RETAINER_SCHEME_CC */
429 #endif /* SECOND_APPROACH */
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
438 outputAllRetainerSet(FILE *prof_file)
442 RetainerSet *rs, **rsArray, *tmp;
444 // find out the number of retainer sets which have had a non-zero cost at
445 // least once during retainer profiling
447 for (i = 0; i < HASH_TABLE_SIZE; i++)
448 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
453 if (numSet == 0) // retainer profiling was not done at all.
457 rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
458 "outputAllRetainerSet()");
460 // prepare for sorting
462 for (i = 0; i < HASH_TABLE_SIZE; i++)
463 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
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) {
478 rsArray[j] = rsArray[j + 1];
479 rsArray[j + 1] = tmp;
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, ", ");
491 printRetainer(prof_file, rsArray[i]->element[j]);
492 fprintf(prof_file, "}\n");
497 #endif // SECOND_APPROACH
499 #endif /* PROFILING */