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