1 /* -----------------------------------------------------------------------------
2 * $Id: RetainerSet.c,v 1.4 2003/03/25 17:58:49 sof Exp $
4 * (c) The GHC Team, 2001
7 * Retainer set implementation for retainer profiling (see RetainerProfile.c)
9 * ---------------------------------------------------------------------------*/
19 #include "RetainerSet.h"
21 #include "Profiling.h"
25 #define HASH_TABLE_SIZE 255
26 #define hash(hk) (hk % HASH_TABLE_SIZE)
27 static RetainerSet *hashTable[HASH_TABLE_SIZE];
29 static Arena *arena; // arena in which we store retainer sets
31 static int nextId; // id of next retainer set
33 /* -----------------------------------------------------------------------------
34 * rs_MANY is a distinguished retainer set, such that
36 * isMember(e, rs_MANY) = True
38 * addElement(e, rs) = rs_MANY, if rs->num >= maxRetainerSetSize
39 * addElement(e, rs_MANY) = rs_MANY
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 = {
52 /* -----------------------------------------------------------------------------
53 * calculate the size of a RetainerSet structure
54 * -------------------------------------------------------------------------- */
56 sizeofRetainerSet( int elems )
58 return (sizeof(RetainerSet) + elems * sizeof(retainer));
61 /* -----------------------------------------------------------------------------
62 * Creates the first pool and initializes hashTable[].
63 * Frees all pools if any.
64 * -------------------------------------------------------------------------- */
66 initializeAllRetainerSet(void)
72 for (i = 0; i < HASH_TABLE_SIZE; i++)
74 nextId = 2; // Initial value must be positive, 2 is MANY.
77 /* -----------------------------------------------------------------------------
78 * Refreshes all pools for reuse and initializes hashTable[].
79 * -------------------------------------------------------------------------- */
81 refreshAllRetainerSet(void)
86 // first approach: completely refresh
90 for (i = 0; i < HASH_TABLE_SIZE; i++)
93 #endif // FIRST_APPROACH
96 /* -----------------------------------------------------------------------------
98 * -------------------------------------------------------------------------- */
100 closeAllRetainerSet(void)
105 /* -----------------------------------------------------------------------------
106 * Finds or creates if needed a singleton retainer set.
107 * -------------------------------------------------------------------------- */
109 singleton(retainer r)
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
119 rs = arenaAlloc( arena, sizeofRetainerSet(1) );
122 rs->link = hashTable[hash(hk)];
126 // The new retainer set is placed at the head of the linked list.
127 hashTable[hash(hk)] = rs;
132 /* -----------------------------------------------------------------------------
133 * Finds or creates a retainer set *rs augmented with r.
135 * r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse.
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 * -------------------------------------------------------------------------- */
143 addElement(retainer r, RetainerSet *rs)
146 nat nl; // Number of retainers in *rs Less than r
147 RetainerSet *nrs; // New Retainer Set
148 StgWord hk; // Hash Key
150 #ifdef DEBUG_RETAINER
151 // fprintf(stderr, "addElement(%p, %p) = ", r, rs);
155 ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
157 if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
161 ASSERT(!isMember(r, rs));
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.
170 hk = hashKeyAddElement(r, rs);
171 for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
172 // test *rs and *nrs for equality
175 if (rs->num + 1 != nrs->num) continue;
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;
183 if (r != nrs->element[i]) continue; // i == nl
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;
190 #ifdef DEBUG_RETAINER
191 // fprintf(stderr, "%p\n", nrs);
193 // The set we are seeking already exists!
197 // create a new retainer set
198 nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
199 nrs->num = rs->num + 1;
201 nrs->link = hashTable[hash(hk)];
203 for (i = 0; i < nl; i++) { // copy the first nl retainers
204 nrs->element[i] = rs->element[i];
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];
211 hashTable[hash(hk)] = nrs;
213 #ifdef DEBUG_RETAINER
214 // fprintf(stderr, "%p\n", nrs);
219 /* -----------------------------------------------------------------------------
220 * Call f() for each retainer set.
221 * -------------------------------------------------------------------------- */
223 traverseAllRetainerSet(void (*f)(RetainerSet *))
229 for (i = 0; i < HASH_TABLE_SIZE; i++)
230 for (rs = hashTable[i]; rs != NULL; rs = rs->link)
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
242 printRetainer(FILE *f, retainer itbl)
244 fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type);
246 #elif defined(RETAINER_SCHEME_CCS)
247 // Retainer scheme 2: retainer = cost centre stack
249 printRetainer(FILE *f, retainer ccs)
253 #elif defined(RETAINER_SCHEME_CC)
254 // Retainer scheme 3: retainer = cost centre
256 printRetainer(FILE *f, retainer cc)
258 fprintf(f,"%s.%s", cc->module, cc->label);
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
270 printRetainerSetShort(FILE *f, RetainerSet *rs)
272 #define MAX_RETAINER_SET_SPACE 24
273 char tmp[MAX_RETAINER_SET_SPACE + 1];
279 tmp[MAX_RETAINER_SET_SPACE] = '\0';
281 // No blank characters are allowed.
282 sprintf(tmp + 0, "(%d)", -(rs->id));
284 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
290 if (size == MAX_RETAINER_SET_SPACE)
292 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
294 if (size == MAX_RETAINER_SET_SPACE)
298 strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
299 // size = strlen(tmp);
304 #elif defined(RETAINER_SCHEME_CC)
305 // Retainer scheme 3: retainer = cost centre
307 printRetainerSetShort(FILE *f, RetainerSet *rs)
309 #define MAX_RETAINER_SET_SPACE 24
310 char tmp[MAX_RETAINER_SET_SPACE + 1];
315 #elif defined(RETAINER_SCHEME_CCS)
316 // Retainer scheme 2: retainer = cost centre stack
318 printRetainerSetShort(FILE *f, RetainerSet *rs)
320 #define MAX_RETAINER_SET_SPACE 24
321 char tmp[MAX_RETAINER_SET_SPACE + 1];
327 tmp[MAX_RETAINER_SET_SPACE] = '\0';
329 // No blank characters are allowed.
330 sprintf(tmp + 0, "(%d)", -(rs->id));
332 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
338 if (size == MAX_RETAINER_SET_SPACE)
340 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
342 if (size == MAX_RETAINER_SET_SPACE)
346 strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
347 // size = strlen(tmp);
352 #elif defined(RETAINER_SCHEME_CC)
353 // Retainer scheme 3: retainer = cost centre
355 printRetainerSetShort(FILE *f, retainerSet *rs)
357 #define MAX_RETAINER_SET_SPACE 24
358 char tmp[MAX_RETAINER_SET_SPACE + 1];
364 tmp[MAX_RETAINER_SET_SPACE] = '\0';
366 // No blank characters are allowed.
367 sprintf(tmp + 0, "(%d)", -(rs->id));
369 ASSERT(size < MAX_RETAINER_SET_SPACE);
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);
376 if (size == MAX_RETAINER_SET_SPACE)
378 strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
380 if (size == MAX_RETAINER_SET_SPACE)
384 strncpy(tmp + size, rs->element[j]->label,
385 MAX_RETAINER_SET_SPACE - size);
386 // size = strlen(tmp);
391 #define MAX_RETAINER_SET_SPACE 24
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 ')').
402 // No blank characters are allowed.
403 sprintf(tmp + 0, "(%d)", -(rs->id));
405 ASSERT(size < MAX_RETAINER_SET_SPACE - DOT_NUMBER);
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, "...");
414 sprintf(tmp + size, "%s,", rs->element[j]->label);
418 if (size + ts > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
419 sprintf(tmp + size, "...");
422 sprintf(tmp + size, "%s", rs->element[j]->label);
429 #endif /* RETAINER_SCHEME_CC */
430 #endif /* SECOND_APPROACH */
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
439 outputAllRetainerSet(FILE *prof_file)
443 RetainerSet *rs, **rsArray, *tmp;
445 // find out the number of retainer sets which have had a non-zero cost at
446 // least once during retainer profiling
448 for (i = 0; i < HASH_TABLE_SIZE; i++)
449 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
454 if (numSet == 0) // retainer profiling was not done at all.
458 rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
459 "outputAllRetainerSet()");
461 // prepare for sorting
463 for (i = 0; i < HASH_TABLE_SIZE; i++)
464 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
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) {
479 rsArray[j] = rsArray[j + 1];
480 rsArray[j + 1] = tmp;
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, ", ");
492 printRetainer(prof_file, rsArray[i]->element[j]);
493 fprintf(prof_file, "}\n");
498 #endif // SECOND_APPROACH
500 #endif /* PROFILING */