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 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
stableNameLock(void)42 stableNameLock(void)
43 {
44 initStableNameTable();
45 ACQUIRE_LOCK(&stable_name_mutex);
46 }
47
48 void
stableNameUnlock(void)49 stableNameUnlock(void)
50 {
51 RELEASE_LOCK(&stable_name_mutex);
52 }
53
54 /* -----------------------------------------------------------------------------
55 * Initialising the table
56 * -------------------------------------------------------------------------- */
57
58 STATIC_INLINE void
initSnEntryFreeList(snEntry * table,uint32_t n,snEntry * free)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
initStableNameTable(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
enlargeStableNameTable(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
110 /* -----------------------------------------------------------------------------
111 * Freeing entries and tables
112 * -------------------------------------------------------------------------- */
113
114 void
exitStableNameTable(void)115 exitStableNameTable(void)
116 {
117 if (addrToStableHash)
118 freeHashTable(addrToStableHash, NULL);
119 addrToStableHash = NULL;
120
121 if (stable_name_table)
122 stgFree(stable_name_table);
123 stable_name_table = NULL;
124 SNT_size = 0;
125
126 #if defined(THREADED_RTS)
127 closeMutex(&stable_name_mutex);
128 #endif
129 }
130
131 void
freeSnEntry(snEntry * sn)132 freeSnEntry(snEntry *sn)
133 {
134 ASSERT(sn->sn_obj == NULL);
135 removeHashTable(addrToStableHash, (W_)sn->old, NULL);
136 sn->addr = (P_)stable_name_free;
137 stable_name_free = sn;
138 }
139
140 /* -----------------------------------------------------------------------------
141 * Looking up
142 * -------------------------------------------------------------------------- */
143
144 /*
145 * get at the real stuff...remove indirections.
146 */
147 static StgClosure*
removeIndirections(StgClosure * p)148 removeIndirections (StgClosure* p)
149 {
150 StgClosure* q;
151
152 while (1)
153 {
154 q = UNTAG_CLOSURE(p);
155
156 switch (get_itbl(q)->type) {
157 case IND:
158 case IND_STATIC:
159 p = ((StgInd *)q)->indirectee;
160 continue;
161
162 case BLACKHOLE:
163 p = ((StgInd *)q)->indirectee;
164 if (GET_CLOSURE_TAG(p) != 0) {
165 continue;
166 } else {
167 break;
168 }
169
170 default:
171 break;
172 }
173 return p;
174 }
175 }
176
177 StgWord
lookupStableName(StgPtr p)178 lookupStableName (StgPtr p)
179 {
180 stableNameLock();
181
182 if (stable_name_free == NULL) {
183 enlargeStableNameTable();
184 }
185
186 /* removing indirections increases the likelihood
187 * of finding a match in the stable name hash table.
188 */
189 p = (StgPtr)removeIndirections((StgClosure*)p);
190
191 // register the untagged pointer. This just makes things simpler.
192 p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
193
194 StgWord sn = (StgWord)lookupHashTable(addrToStableHash,(W_)p);
195
196 if (sn != 0) {
197 ASSERT(stable_name_table[sn].addr == p);
198 debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
199 stableNameUnlock();
200 return sn;
201 }
202
203 sn = stable_name_free - stable_name_table;
204 stable_name_free = (snEntry*)(stable_name_free->addr);
205 stable_name_table[sn].addr = p;
206 stable_name_table[sn].sn_obj = NULL;
207 /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
208
209 /* add the new stable name to the hash table */
210 insertHashTable(addrToStableHash, (W_)p, (void *)sn);
211
212 stableNameUnlock();
213
214 return sn;
215 }
216
217 /* -----------------------------------------------------------------------------
218 * Remember old stable name addresses
219 * -------------------------------------------------------------------------- */
220
221 void
rememberOldStableNameAddresses(void)222 rememberOldStableNameAddresses(void)
223 {
224 /* TODO: Only if !full GC */
225 FOR_EACH_STABLE_NAME(p, p->old = p->addr;);
226 }
227
228 /* -----------------------------------------------------------------------------
229 * Thread the stable name table for compacting GC.
230 *
231 * Here we must call the supplied evac function for each pointer into
232 * the heap from the stable name table, because the compacting
233 * collector may move the object it points to.
234 * -------------------------------------------------------------------------- */
235
236 void
threadStableNameTable(evac_fn evac,void * user)237 threadStableNameTable( evac_fn evac, void *user )
238 {
239 FOR_EACH_STABLE_NAME(p, {
240 if (p->sn_obj != NULL) {
241 evac(user, (StgClosure **)&p->sn_obj);
242 }
243 if (p->addr != NULL) {
244 evac(user, (StgClosure **)&p->addr);
245 }
246 });
247 }
248
249 /* -----------------------------------------------------------------------------
250 * Garbage collect any dead entries in the stable name table.
251 *
252 * A dead entry has:
253 *
254 * - a zero reference count
255 * - a dead sn_obj
256 *
257 * Both of these conditions must be true in order to re-use the stable
258 * name table entry. We can re-use stable name table entries for live
259 * heap objects, as long as the program has no StableName objects that
260 * refer to the entry.
261 * -------------------------------------------------------------------------- */
262
263 void
gcStableNameTable(void)264 gcStableNameTable( void )
265 {
266 // We must take the stable name lock lest we race with the nonmoving
267 // collector (namely nonmovingSweepStableNameTable).
268 stableNameLock();
269 FOR_EACH_STABLE_NAME(
270 p, {
271 // FOR_EACH_STABLE_NAME traverses free entries too, so
272 // check sn_obj
273 if (p->sn_obj != NULL) {
274 // Update the pointer to the StableName object, if there is one
275 p->sn_obj = isAlive(p->sn_obj);
276 if (p->sn_obj == NULL) {
277 // StableName object died
278 debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
279 (long)(p - stable_name_table), p->addr);
280 freeSnEntry(p);
281 } else if (p->addr != NULL) {
282 // sn_obj is alive, update pointee
283 p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
284 if (p->addr == NULL) {
285 // Pointee died
286 debugTrace(DEBUG_stable, "GC'd pointee %ld",
287 (long)(p - stable_name_table));
288 }
289 }
290 }
291 });
292 stableNameUnlock();
293 }
294
295 /* -----------------------------------------------------------------------------
296 * Update the StableName hash table
297 *
298 * The boolean argument 'full' indicates that a major collection is
299 * being done, so we might as well throw away the hash table and build
300 * a new one. For a minor collection, we just re-hash the elements
301 * that changed.
302 * -------------------------------------------------------------------------- */
303
304 void
updateStableNameTable(bool full)305 updateStableNameTable(bool full)
306 {
307 if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) {
308 freeHashTable(addrToStableHash,NULL);
309 addrToStableHash = allocHashTable();
310 }
311
312 if(full) {
313 FOR_EACH_STABLE_NAME(
314 p, {
315 if (p->addr != NULL) {
316 // Target still alive, Re-hash this stable name
317 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
318 }
319 });
320 } else {
321 FOR_EACH_STABLE_NAME(
322 p, {
323 if (p->addr != p->old) {
324 removeHashTable(addrToStableHash, (W_)p->old, NULL);
325 /* Movement happened: */
326 if (p->addr != NULL) {
327 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
328 }
329 }
330 });
331 }
332 }
333