abe7b692e0c4ec49c4679537bdf48c579ee9eaa1
[ghc.git] / rts / StableName.c
1 /* -*- tab-width: 4 -*- */
2
3 /* -----------------------------------------------------------------------------
4 *
5 * (c) The GHC Team, 1998-2002
6 *
7 * Stable names
8 *
9 * ---------------------------------------------------------------------------*/
10
11 #include "PosixSource.h"
12 #include "Rts.h"
13 #include "RtsAPI.h"
14
15 #include "Hash.h"
16 #include "RtsUtils.h"
17 #include "Trace.h"
18 #include "StableName.h"
19
20 #include <string.h>
21
22 snEntry *stable_name_table = NULL;
23 static snEntry *stable_name_free = NULL;
24 static unsigned int SNT_size = 0;
25 #define INIT_SNT_SIZE 64
26
27 #if defined(THREADED_RTS)
28 Mutex stable_name_mutex;
29 #endif
30
31 static void enlargeStableNameTable(void);
32
33 /*
34 * This hash table maps Haskell objects to stable names, so that every
35 * call to lookupStableName on a given object will return the same
36 * stable name.
37 */
38
39 static HashTable *addrToStableHash = NULL;
40
41 void
42 stableNameLock(void)
43 {
44 initStableNameTable();
45 ACQUIRE_LOCK(&stable_name_mutex);
46 }
47
48 void
49 stableNameUnlock(void)
50 {
51 RELEASE_LOCK(&stable_name_mutex);
52 }
53
54 /* -----------------------------------------------------------------------------
55 * Initialising the table
56 * -------------------------------------------------------------------------- */
57
58 STATIC_INLINE void
59 initSnEntryFreeList(snEntry *table, uint32_t n, snEntry *free)
60 {
61 snEntry *p;
62 for (p = table + n - 1; p >= table; p--) {
63 p->addr = (P_)free;
64 p->old = NULL;
65 p->sn_obj = NULL;
66 free = p;
67 }
68 stable_name_free = table;
69 }
70
71 void
72 initStableNameTable(void)
73 {
74 if (SNT_size > 0) return;
75 SNT_size = INIT_SNT_SIZE;
76 stable_name_table = stgMallocBytes(SNT_size * sizeof(snEntry),
77 "initStableNameTable");
78 /* we don't use index 0 in the stable name table, because that
79 * would conflict with the hash table lookup operations which
80 * return NULL if an entry isn't found in the hash table.
81 */
82 initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL);
83 addrToStableHash = allocHashTable();
84
85 #if defined(THREADED_RTS)
86 initMutex(&stable_name_mutex);
87 #endif
88 }
89
90 /* -----------------------------------------------------------------------------
91 * Enlarging the tables
92 * -------------------------------------------------------------------------- */
93
94 static void
95 enlargeStableNameTable(void)
96 {
97 uint32_t old_SNT_size = SNT_size;
98
99 // 2nd and subsequent times
100 SNT_size *= 2;
101 stable_name_table =
102 stgReallocBytes(stable_name_table,
103 SNT_size * sizeof(snEntry),
104 "enlargeStableNameTable");
105
106 initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL);
107 }
108
109 /* Note [Enlarging the stable pointer table]
110 *
111 * To enlarge the stable pointer table, we allocate a new table, copy the
112 * existing entries, and then store the old version of the table in old_SPTs
113 * until we free it during GC. By not immediately freeing the old version
114 * (or equivalently by not growing the table using realloc()), we ensure that
115 * another thread simultaneously dereferencing a stable pointer using the old
116 * version can safely access the table without causing a segfault (see Trac
117 * #10296).
118 *
119 * Note that because the stable pointer table is doubled in size each time it is
120 * enlarged, the total memory needed to store the old versions is always less
121 * than that required to hold the current version.
122 */
123
124
125 /* -----------------------------------------------------------------------------
126 * Freeing entries and tables
127 * -------------------------------------------------------------------------- */
128
129 void
130 exitStableNameTable(void)
131 {
132 if (addrToStableHash)
133 freeHashTable(addrToStableHash, NULL);
134 addrToStableHash = NULL;
135
136 if (stable_name_table)
137 stgFree(stable_name_table);
138 stable_name_table = NULL;
139 SNT_size = 0;
140
141 #if defined(THREADED_RTS)
142 closeMutex(&stable_name_mutex);
143 #endif
144 }
145
146 STATIC_INLINE void
147 freeSnEntry(snEntry *sn)
148 {
149 ASSERT(sn->sn_obj == NULL);
150 removeHashTable(addrToStableHash, (W_)sn->old, NULL);
151 sn->addr = (P_)stable_name_free;
152 stable_name_free = sn;
153 }
154
155 /* -----------------------------------------------------------------------------
156 * Looking up
157 * -------------------------------------------------------------------------- */
158
159 /*
160 * get at the real stuff...remove indirections.
161 */
162 static StgClosure*
163 removeIndirections (StgClosure* p)
164 {
165 StgClosure* q;
166
167 while (1)
168 {
169 q = UNTAG_CLOSURE(p);
170
171 switch (get_itbl(q)->type) {
172 case IND:
173 case IND_STATIC:
174 p = ((StgInd *)q)->indirectee;
175 continue;
176
177 case BLACKHOLE:
178 p = ((StgInd *)q)->indirectee;
179 if (GET_CLOSURE_TAG(p) != 0) {
180 continue;
181 } else {
182 break;
183 }
184
185 default:
186 break;
187 }
188 return p;
189 }
190 }
191
192 StgWord
193 lookupStableName (StgPtr p)
194 {
195 stableNameLock();
196
197 if (stable_name_free == NULL) {
198 enlargeStableNameTable();
199 }
200
201 /* removing indirections increases the likelihood
202 * of finding a match in the stable name hash table.
203 */
204 p = (StgPtr)removeIndirections((StgClosure*)p);
205
206 // register the untagged pointer. This just makes things simpler.
207 p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
208
209 StgWord sn = (StgWord)lookupHashTable(addrToStableHash,(W_)p);
210
211 if (sn != 0) {
212 ASSERT(stable_name_table[sn].addr == p);
213 debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
214 stableNameUnlock();
215 return sn;
216 }
217
218 sn = stable_name_free - stable_name_table;
219 stable_name_free = (snEntry*)(stable_name_free->addr);
220 stable_name_table[sn].addr = p;
221 stable_name_table[sn].sn_obj = NULL;
222 /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
223
224 /* add the new stable name to the hash table */
225 insertHashTable(addrToStableHash, (W_)p, (void *)sn);
226
227 stableNameUnlock();
228
229 return sn;
230 }
231
232 /* -----------------------------------------------------------------------------
233 * Remember old stable name addresses
234 * -------------------------------------------------------------------------- */
235
236 #define FOR_EACH_STABLE_NAME(p, CODE) \
237 do { \
238 snEntry *p; \
239 snEntry *__end_ptr = &stable_name_table[SNT_size]; \
240 for (p = stable_name_table + 1; p < __end_ptr; p++) { \
241 /* Internal pointers are free slots. */ \
242 /* If p->addr == NULL, it's a */ \
243 /* stable name where the object has been GC'd, but the */ \
244 /* StableName object (sn_obj) is still alive. */ \
245 if ((p->addr < (P_)stable_name_table || \
246 p->addr >= (P_)__end_ptr)) \
247 { \
248 /* NOTE: There is an ambiguity here if p->addr == NULL */ \
249 /* it is either the last item in the free list or it */ \
250 /* is a stable name whose pointee died. sn_obj == NULL */ \
251 /* disambiguates as last free list item. */ \
252 do { CODE } while(0); \
253 } \
254 } \
255 } while(0)
256
257 void
258 rememberOldStableNameAddresses(void)
259 {
260 /* TODO: Only if !full GC */
261 FOR_EACH_STABLE_NAME(p, p->old = p->addr;);
262 }
263
264 /* -----------------------------------------------------------------------------
265 * Thread the stable pointer table for compacting GC.
266 *
267 * Here we must call the supplied evac function for each pointer into
268 * the heap from the stable tables, because the compacting
269 * collector may move the object it points to.
270 * -------------------------------------------------------------------------- */
271
272 void
273 threadStableNameTable( evac_fn evac, void *user )
274 {
275 FOR_EACH_STABLE_NAME(p, {
276 if (p->sn_obj != NULL) {
277 evac(user, (StgClosure **)&p->sn_obj);
278 }
279 if (p->addr != NULL) {
280 evac(user, (StgClosure **)&p->addr);
281 }
282 });
283 }
284
285 /* -----------------------------------------------------------------------------
286 * Garbage collect any dead entries in the stable name table.
287 *
288 * A dead entry has:
289 *
290 * - a zero reference count
291 * - a dead sn_obj
292 *
293 * Both of these conditions must be true in order to re-use the stable
294 * name table entry. We can re-use stable name table entries for live
295 * heap objects, as long as the program has no StableName objects that
296 * refer to the entry.
297 * -------------------------------------------------------------------------- */
298
299 void
300 gcStableNameTable( void )
301 {
302 FOR_EACH_STABLE_NAME(
303 p, {
304 // FOR_EACH_STABLE_NAME traverses free entries too, so
305 // check sn_obj
306 if (p->sn_obj != NULL) {
307 // Update the pointer to the StableName object, if there is one
308 p->sn_obj = isAlive(p->sn_obj);
309 if (p->sn_obj == NULL) {
310 // StableName object died
311 debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
312 (long)(p - stable_name_table), p->addr);
313 freeSnEntry(p);
314 } else if (p->addr != NULL) {
315 // sn_obj is alive, update pointee
316 p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
317 if (p->addr == NULL) {
318 // Pointee died
319 debugTrace(DEBUG_stable, "GC'd pointee %ld",
320 (long)(p - stable_name_table));
321 }
322 }
323 }
324 });
325 }
326
327 /* -----------------------------------------------------------------------------
328 * Update the StableName hash table
329 *
330 * The boolean argument 'full' indicates that a major collection is
331 * being done, so we might as well throw away the hash table and build
332 * a new one. For a minor collection, we just re-hash the elements
333 * that changed.
334 * -------------------------------------------------------------------------- */
335
336 void
337 updateStableNameTable(bool full)
338 {
339 if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) {
340 freeHashTable(addrToStableHash,NULL);
341 addrToStableHash = allocHashTable();
342 }
343
344 if(full) {
345 FOR_EACH_STABLE_NAME(
346 p, {
347 if (p->addr != NULL) {
348 // Target still alive, Re-hash this stable name
349 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
350 }
351 });
352 } else {
353 FOR_EACH_STABLE_NAME(
354 p, {
355 if (p->addr != p->old) {
356 removeHashTable(addrToStableHash, (W_)p->old, NULL);
357 /* Movement happened: */
358 if (p->addr != NULL) {
359 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
360 }
361 }
362 });
363 }
364 }