hadrian: Throw error on duplicate-named flavours
[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 #if defined(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 #include "Trace.h"
21
22 #include <string.h>
23
24 #define HASH_TABLE_SIZE 255
25 #define hash(hk) (hk % HASH_TABLE_SIZE)
26 static RetainerSet *hashTable[HASH_TABLE_SIZE];
27
28 static Arena *arena; // arena in which we store retainer sets
29
30 static int nextId; // id of next retainer set
31
32 /* -----------------------------------------------------------------------------
33 * rs_MANY is a distinguished retainer set, such that
34 *
35 * isMember(e, rs_MANY) = True
36 *
37 * addElement(e, rs) = rs_MANY, if rs->num >= maxRetainerSetSize
38 * addElement(e, rs_MANY) = rs_MANY
39 *
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 = {
44 .num = 0,
45 .hashKey = 0,
46 .link = NULL,
47 .id = 1,
48 .element = {}
49 };
50
51 /* -----------------------------------------------------------------------------
52 * calculate the size of a RetainerSet structure
53 * -------------------------------------------------------------------------- */
54 STATIC_INLINE size_t
55 sizeofRetainerSet( int elems )
56 {
57 return (sizeof(RetainerSet) + elems * sizeof(retainer));
58 }
59
60 /* -----------------------------------------------------------------------------
61 * Creates the first pool and initializes hashTable[].
62 * Frees all pools if any.
63 * -------------------------------------------------------------------------- */
64 void
65 initializeAllRetainerSet(void)
66 {
67 int i;
68
69 arena = newArena();
70
71 for (i = 0; i < HASH_TABLE_SIZE; i++)
72 hashTable[i] = NULL;
73 nextId = 2; // Initial value must be positive, 2 is MANY.
74 }
75
76 /* -----------------------------------------------------------------------------
77 * Frees all pools.
78 * -------------------------------------------------------------------------- */
79 void
80 closeAllRetainerSet(void)
81 {
82 arenaFree(arena);
83 }
84
85 /* -----------------------------------------------------------------------------
86 * Finds or creates if needed a singleton retainer set.
87 * -------------------------------------------------------------------------- */
88 RetainerSet *
89 singleton(retainer r)
90 {
91 RetainerSet *rs;
92 StgWord hk;
93
94 hk = hashKeySingleton(r);
95 for (rs = hashTable[hash(hk)]; rs != NULL; rs = rs->link)
96 if (rs->num == 1 && rs->element[0] == r) return rs; // found it
97
98 // create it
99 rs = arenaAlloc( arena, sizeofRetainerSet(1) );
100 rs->num = 1;
101 rs->hashKey = hk;
102 rs->link = hashTable[hash(hk)];
103 rs->id = nextId++;
104 rs->element[0] = r;
105
106 // The new retainer set is placed at the head of the linked list.
107 hashTable[hash(hk)] = rs;
108
109 return rs;
110 }
111
112 /* -----------------------------------------------------------------------------
113 * Finds or creates a retainer set *rs augmented with r.
114 * Invariants:
115 * r is not a member of rs, i.e., isMember(r, rs) returns false.
116 * rs is not NULL.
117 * Note:
118 * We could check if rs is NULL, in which case this function call
119 * reverts to singleton(). We do not choose this strategy because
120 * in most cases addElement() is invoked with non-NULL rs.
121 * -------------------------------------------------------------------------- */
122 RetainerSet *
123 addElement(retainer r, RetainerSet *rs)
124 {
125 uint32_t i;
126 uint32_t nl; // Number of retainers in *rs Less than r
127 RetainerSet *nrs; // New Retainer Set
128 StgWord hk; // Hash Key
129
130 // debugBelch("addElement(%p, %p) = ", r, rs);
131
132 ASSERT(rs != NULL);
133 ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
134
135 if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
136 return &rs_MANY;
137 }
138
139 ASSERT(!isMember(r, rs));
140
141 for (nl = 0; nl < rs->num; nl++)
142 if (r < rs->element[nl]) break;
143 // Now nl is the index for r into the new set.
144 // Also it denotes the number of retainers less than r in *rs.
145 // Thus, compare the first nl retainers, then r itself, and finally the
146 // remaining (rs->num - nl) retainers.
147
148 hk = hashKeyAddElement(r, rs);
149 for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
150 // test *rs and *nrs for equality
151
152 // check their size
153 if (rs->num + 1 != nrs->num) continue;
154
155 // compare the first nl retainers and find the first non-matching one.
156 for (i = 0; i < nl; i++)
157 if (rs->element[i] != nrs->element[i]) break;
158 if (i < nl) continue;
159
160 // compare r itself
161 if (r != nrs->element[i]) continue; // i == nl
162
163 // compare the remaining retainers
164 for (; i < rs->num; i++)
165 if (rs->element[i] != nrs->element[i + 1]) break;
166 if (i < rs->num) continue;
167
168 // debugBelch("%p\n", nrs);
169
170 // The set we are seeking already exists!
171 return nrs;
172 }
173
174 // create a new retainer set
175 nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
176 nrs->num = rs->num + 1;
177 nrs->hashKey = hk;
178 nrs->link = hashTable[hash(hk)];
179 nrs->id = nextId++;
180 for (i = 0; i < nl; i++) { // copy the first nl retainers
181 nrs->element[i] = rs->element[i];
182 }
183 nrs->element[i] = r; // copy r
184 for (; i < rs->num; i++) { // copy the remaining retainers
185 nrs->element[i + 1] = rs->element[i];
186 }
187
188 hashTable[hash(hk)] = nrs;
189
190 // debugBelch("%p\n", nrs);
191 return nrs;
192 }
193
194 /* -----------------------------------------------------------------------------
195 * printRetainer() prints the full information on a given retainer,
196 * not a retainer set.
197 * -------------------------------------------------------------------------- */
198 static void
199 printRetainer(FILE *f, retainer ccs)
200 {
201 fprintCCS(f, ccs);
202 }
203
204 /* -----------------------------------------------------------------------------
205 * printRetainerSetShort() should always display the same output for
206 * a given retainer set regardless of the time of invocation.
207 * -------------------------------------------------------------------------- */
208 void
209 printRetainerSetShort(FILE *f, RetainerSet *rs, W_ total_size, uint32_t max_length)
210 {
211 char tmp[max_length + 1];
212 uint32_t size;
213 uint32_t j;
214
215 ASSERT(rs->id < 0);
216
217 tmp[max_length] = '\0';
218
219 // No blank characters are allowed.
220 sprintf(tmp + 0, "(%d)", -(rs->id));
221 size = strlen(tmp);
222 ASSERT(size < max_length);
223
224 for (j = 0; j < rs->num; j++) {
225 if (j < rs->num - 1) {
226 strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
227 size = strlen(tmp);
228 if (size == max_length)
229 break;
230 strncpy(tmp + size, ",", max_length - size);
231 size = strlen(tmp);
232 if (size == max_length)
233 break;
234 }
235 else {
236 strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
237 // size = strlen(tmp);
238 }
239 }
240 fputs(tmp, f);
241 traceHeapProfSampleString(0, tmp, total_size);
242 }
243
244 /* -----------------------------------------------------------------------------
245 * Dump the contents of each retainer set into the log file at the end
246 * of the run, so the user can find out for a given retainer set ID
247 * the full contents of that set.
248 * -------------------------------------------------------------------------- */
249 void
250 outputAllRetainerSet(FILE *prof_file)
251 {
252 uint32_t i, j;
253 uint32_t numSet;
254 RetainerSet *rs, **rsArray, *tmp;
255
256 // find out the number of retainer sets which have had a non-zero cost at
257 // least once during retainer profiling
258 numSet = 0;
259 for (i = 0; i < HASH_TABLE_SIZE; i++)
260 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
261 if (rs->id < 0)
262 numSet++;
263 }
264
265 if (numSet == 0) // retainer profiling was not done at all.
266 return;
267
268 // allocate memory
269 rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
270 "outputAllRetainerSet()");
271
272 // prepare for sorting
273 j = 0;
274 for (i = 0; i < HASH_TABLE_SIZE; i++)
275 for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
276 if (rs->id < 0) {
277 rsArray[j] = rs;
278 j++;
279 }
280 }
281
282 ASSERT(j == numSet);
283
284 // sort rsArray[] according to the id of each retainer set
285 for (i = numSet - 1; i > 0; i--) {
286 for (j = 0; j <= i - 1; j++) {
287 // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
288 if (rsArray[j]->id < rsArray[j + 1]->id) {
289 tmp = rsArray[j];
290 rsArray[j] = rsArray[j + 1];
291 rsArray[j + 1] = tmp;
292 }
293 }
294 }
295
296 fprintf(prof_file, "\nRetainer sets created during profiling:\n");
297 for (i = 0;i < numSet; i++) {
298 fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
299 for (j = 0; j < rsArray[i]->num - 1; j++) {
300 printRetainer(prof_file, rsArray[i]->element[j]);
301 fprintf(prof_file, ", ");
302 }
303 printRetainer(prof_file, rsArray[i]->element[j]);
304 fprintf(prof_file, "}\n");
305 }
306
307 stgFree(rsArray);
308 }
309
310 #endif /* PROFILING */