Document SRT scavenging behavior of scavenge_block() and scavenge_one()
[ghc.git] / rts / Stable.c
1 /* -*- tab-width: 4 -*- */
2
3 /* -----------------------------------------------------------------------------
4 *
5 * (c) The GHC Team, 1998-2002
6 *
7 * Stable names and stable pointers.
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 "Stable.h"
19
20 #include <string.h>
21
22 /* Comment from ADR's implementation in old RTS:
23
24 This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
25 small change in @HpOverflow.lc@) consists of the changes in the
26 runtime system required to implement "Stable Pointers". But we're
27 getting a bit ahead of ourselves --- what is a stable pointer and what
28 is it used for?
29
30 When Haskell calls C, it normally just passes over primitive integers,
31 floats, bools, strings, etc. This doesn't cause any problems at all
32 for garbage collection because the act of passing them makes a copy
33 from the heap, stack or wherever they are onto the C-world stack.
34 However, if we were to pass a heap object such as a (Haskell) @String@
35 and a garbage collection occured before we finished using it, we'd run
36 into problems since the heap object might have been moved or even
37 deleted.
38
39 So, if a C call is able to cause a garbage collection or we want to
40 store a pointer to a heap object between C calls, we must be careful
41 when passing heap objects. Our solution is to keep a table of all
42 objects we've given to the C-world and to make sure that the garbage
43 collector collects these objects --- updating the table as required to
44 make sure we can still find the object.
45
46
47 Of course, all this rather begs the question: why would we want to
48 pass a boxed value?
49
50 One very good reason is to preserve laziness across the language
51 interface. Rather than evaluating an integer or a string because it
52 {\em might\/} be required by the C function, we can wait until the C
53 function actually wants the value and then force an evaluation.
54
55 Another very good reason (the motivating reason!) is that the C code
56 might want to execute an object of sort $IO ()$ for the side-effects
57 it will produce. For example, this is used when interfacing to an X
58 widgets library to allow a direct implementation of callbacks.
59
60 One final reason is that we may want to store composite Haskell
61 values in data structures implemented in the C side. Serializing and
62 deserializing these structures into unboxed form suitable for C may
63 be more expensive than maintaining the extra layer of indirection of
64 stable pointers.
65
66 The @makeStablePointer :: a -> IO (StablePtr a)@ function
67 converts a value into a stable pointer. It is part of the @PrimIO@
68 monad, because we want to be sure we don't allocate one twice by
69 accident, and then only free one of the copies.
70
71 \begin{verbatim}
72 makeStablePtr# :: a -> State# RealWorld -> (# RealWorld, a #)
73 freeStablePtr# :: StablePtr# a -> State# RealWorld -> State# RealWorld
74 deRefStablePtr# :: StablePtr# a -> State# RealWorld ->
75 (# State# RealWorld, a #)
76 \end{verbatim}
77
78 There may be additional functions on the C side to allow evaluation,
79 application, etc of a stable pointer.
80
81 Stable Pointers are exported to the outside world as indices and not
82 pointers, because the stable pointer table is allowed to be
83 reallocated for growth. The table is never shrunk for its space to
84 be reclaimed.
85
86 Future plans for stable ptrs include distinguishing them by the
87 generation of the pointed object. See
88 http://ghc.haskell.org/trac/ghc/ticket/7670 for details.
89 */
90
91 snEntry *stable_name_table = NULL;
92 static snEntry *stable_name_free = NULL;
93 static unsigned int SNT_size = 0;
94 #define INIT_SNT_SIZE 64
95
96 spEntry *stable_ptr_table = NULL;
97 static spEntry *stable_ptr_free = NULL;
98 static unsigned int SPT_size = 0;
99 #define INIT_SPT_SIZE 64
100
101 /* Each time the stable pointer table is enlarged, we temporarily retain the old
102 * version to ensure dereferences are thread-safe (see Note [Enlarging the
103 * stable pointer table]). Since we double the size of the table each time, we
104 * can (theoretically) enlarge it at most N times on an N-bit machine. Thus,
105 * there will never be more than N old versions of the table.
106 */
107 #if SIZEOF_VOID_P == 4
108 #define MAX_N_OLD_SPTS 32
109 #elif SIZEOF_VOID_P == 8
110 #define MAX_N_OLD_SPTS 64
111 #else
112 #error unknown SIZEOF_VOID_P
113 #endif
114
115 static spEntry *old_SPTs[MAX_N_OLD_SPTS];
116 static uint32_t n_old_SPTs = 0;
117
118 #if defined(THREADED_RTS)
119 Mutex stable_mutex;
120 #endif
121
122 static void enlargeStableNameTable(void);
123 static void enlargeStablePtrTable(void);
124
125 /*
126 * This hash table maps Haskell objects to stable names, so that every
127 * call to lookupStableName on a given object will return the same
128 * stable name.
129 */
130
131 static HashTable *addrToStableHash = NULL;
132
133 /* -----------------------------------------------------------------------------
134 * We must lock the StablePtr table during GC, to prevent simultaneous
135 * calls to freeStablePtr().
136 * -------------------------------------------------------------------------- */
137
138 void
139 stableLock(void)
140 {
141 initStableTables();
142 ACQUIRE_LOCK(&stable_mutex);
143 }
144
145 void
146 stableUnlock(void)
147 {
148 RELEASE_LOCK(&stable_mutex);
149 }
150
151 /* -----------------------------------------------------------------------------
152 * Initialising the tables
153 * -------------------------------------------------------------------------- */
154
155 STATIC_INLINE void
156 initSnEntryFreeList(snEntry *table, uint32_t n, snEntry *free)
157 {
158 snEntry *p;
159 for (p = table + n - 1; p >= table; p--) {
160 p->addr = (P_)free;
161 p->old = NULL;
162 p->sn_obj = NULL;
163 free = p;
164 }
165 stable_name_free = table;
166 }
167
168 STATIC_INLINE void
169 initSpEntryFreeList(spEntry *table, uint32_t n, spEntry *free)
170 {
171 spEntry *p;
172 for (p = table + n - 1; p >= table; p--) {
173 p->addr = (P_)free;
174 free = p;
175 }
176 stable_ptr_free = table;
177 }
178
179 void
180 initStableTables(void)
181 {
182 if (SNT_size > 0) return;
183 SNT_size = INIT_SNT_SIZE;
184 stable_name_table = stgMallocBytes(SNT_size * sizeof(snEntry),
185 "initStableNameTable");
186 /* we don't use index 0 in the stable name table, because that
187 * would conflict with the hash table lookup operations which
188 * return NULL if an entry isn't found in the hash table.
189 */
190 initSnEntryFreeList(stable_name_table + 1,INIT_SNT_SIZE-1,NULL);
191 addrToStableHash = allocHashTable();
192
193 if (SPT_size > 0) return;
194 SPT_size = INIT_SPT_SIZE;
195 stable_ptr_table = stgMallocBytes(SPT_size * sizeof(spEntry),
196 "initStablePtrTable");
197 initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL);
198
199 #if defined(THREADED_RTS)
200 initMutex(&stable_mutex);
201 #endif
202 }
203
204 /* -----------------------------------------------------------------------------
205 * Enlarging the tables
206 * -------------------------------------------------------------------------- */
207
208 static void
209 enlargeStableNameTable(void)
210 {
211 uint32_t old_SNT_size = SNT_size;
212
213 // 2nd and subsequent times
214 SNT_size *= 2;
215 stable_name_table =
216 stgReallocBytes(stable_name_table,
217 SNT_size * sizeof(snEntry),
218 "enlargeStableNameTable");
219
220 initSnEntryFreeList(stable_name_table + old_SNT_size, old_SNT_size, NULL);
221 }
222
223 // Must be holding stable_mutex
224 static void
225 enlargeStablePtrTable(void)
226 {
227 uint32_t old_SPT_size = SPT_size;
228 spEntry *new_stable_ptr_table;
229
230 // 2nd and subsequent times
231 SPT_size *= 2;
232
233 /* We temporarily retain the old version instead of freeing it; see Note
234 * [Enlarging the stable pointer table].
235 */
236 new_stable_ptr_table =
237 stgMallocBytes(SPT_size * sizeof(spEntry),
238 "enlargeStablePtrTable");
239 memcpy(new_stable_ptr_table,
240 stable_ptr_table,
241 old_SPT_size * sizeof(spEntry));
242 ASSERT(n_old_SPTs < MAX_N_OLD_SPTS);
243 old_SPTs[n_old_SPTs++] = stable_ptr_table;
244
245 /* When using the threaded RTS, the update of stable_ptr_table is assumed to
246 * be atomic, so that another thread simultaneously dereferencing a stable
247 * pointer will always read a valid address.
248 */
249 stable_ptr_table = new_stable_ptr_table;
250
251 initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
252 }
253
254 /* Note [Enlarging the stable pointer table]
255 *
256 * To enlarge the stable pointer table, we allocate a new table, copy the
257 * existing entries, and then store the old version of the table in old_SPTs
258 * until we free it during GC. By not immediately freeing the old version
259 * (or equivalently by not growing the table using realloc()), we ensure that
260 * another thread simultaneously dereferencing a stable pointer using the old
261 * version can safely access the table without causing a segfault (see Trac
262 * #10296).
263 *
264 * Note that because the stable pointer table is doubled in size each time it is
265 * enlarged, the total memory needed to store the old versions is always less
266 * than that required to hold the current version.
267 */
268
269
270 /* -----------------------------------------------------------------------------
271 * Freeing entries and tables
272 * -------------------------------------------------------------------------- */
273
274 static void
275 freeOldSPTs(void)
276 {
277 uint32_t i;
278
279 for (i = 0; i < n_old_SPTs; i++) {
280 stgFree(old_SPTs[i]);
281 }
282 n_old_SPTs = 0;
283 }
284
285 void
286 exitStableTables(void)
287 {
288 if (addrToStableHash)
289 freeHashTable(addrToStableHash, NULL);
290 addrToStableHash = NULL;
291
292 if (stable_name_table)
293 stgFree(stable_name_table);
294 stable_name_table = NULL;
295 SNT_size = 0;
296
297 if (stable_ptr_table)
298 stgFree(stable_ptr_table);
299 stable_ptr_table = NULL;
300 SPT_size = 0;
301
302 freeOldSPTs();
303
304 #if defined(THREADED_RTS)
305 closeMutex(&stable_mutex);
306 #endif
307 }
308
309 STATIC_INLINE void
310 freeSnEntry(snEntry *sn)
311 {
312 ASSERT(sn->sn_obj == NULL);
313 removeHashTable(addrToStableHash, (W_)sn->old, NULL);
314 sn->addr = (P_)stable_name_free;
315 stable_name_free = sn;
316 }
317
318 STATIC_INLINE void
319 freeSpEntry(spEntry *sp)
320 {
321 sp->addr = (P_)stable_ptr_free;
322 stable_ptr_free = sp;
323 }
324
325 void
326 freeStablePtrUnsafe(StgStablePtr sp)
327 {
328 ASSERT((StgWord)sp < SPT_size);
329 freeSpEntry(&stable_ptr_table[(StgWord)sp]);
330 }
331
332 void
333 freeStablePtr(StgStablePtr sp)
334 {
335 stableLock();
336 freeStablePtrUnsafe(sp);
337 stableUnlock();
338 }
339
340 /* -----------------------------------------------------------------------------
341 * Looking up
342 * -------------------------------------------------------------------------- */
343
344 /*
345 * get at the real stuff...remove indirections.
346 */
347 static StgClosure*
348 removeIndirections (StgClosure* p)
349 {
350 StgClosure* q;
351
352 while (1)
353 {
354 q = UNTAG_CLOSURE(p);
355
356 switch (get_itbl(q)->type) {
357 case IND:
358 case IND_STATIC:
359 p = ((StgInd *)q)->indirectee;
360 continue;
361
362 case BLACKHOLE:
363 p = ((StgInd *)q)->indirectee;
364 if (GET_CLOSURE_TAG(p) != 0) {
365 continue;
366 } else {
367 break;
368 }
369
370 default:
371 break;
372 }
373 return p;
374 }
375 }
376
377 StgWord
378 lookupStableName (StgPtr p)
379 {
380 stableLock();
381
382 if (stable_name_free == NULL) {
383 enlargeStableNameTable();
384 }
385
386 /* removing indirections increases the likelihood
387 * of finding a match in the stable name hash table.
388 */
389 p = (StgPtr)removeIndirections((StgClosure*)p);
390
391 // register the untagged pointer. This just makes things simpler.
392 p = (StgPtr)UNTAG_CLOSURE((StgClosure*)p);
393
394 StgWord sn = (StgWord)lookupHashTable(addrToStableHash,(W_)p);
395
396 if (sn != 0) {
397 ASSERT(stable_name_table[sn].addr == p);
398 debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
399 stableUnlock();
400 return sn;
401 }
402
403 sn = stable_name_free - stable_name_table;
404 stable_name_free = (snEntry*)(stable_name_free->addr);
405 stable_name_table[sn].addr = p;
406 stable_name_table[sn].sn_obj = NULL;
407 /* debugTrace(DEBUG_stable, "new stable name %d at %p\n",sn,p); */
408
409 /* add the new stable name to the hash table */
410 insertHashTable(addrToStableHash, (W_)p, (void *)sn);
411
412 stableUnlock();
413
414 return sn;
415 }
416
417 StgStablePtr
418 getStablePtr(StgPtr p)
419 {
420 StgWord sp;
421
422 stableLock();
423 if (!stable_ptr_free) enlargeStablePtrTable();
424 sp = stable_ptr_free - stable_ptr_table;
425 stable_ptr_free = (spEntry*)(stable_ptr_free->addr);
426 stable_ptr_table[sp].addr = p;
427 stableUnlock();
428 return (StgStablePtr)(sp);
429 }
430
431 /* -----------------------------------------------------------------------------
432 * Treat stable pointers as roots for the garbage collector.
433 * -------------------------------------------------------------------------- */
434
435 #define FOR_EACH_STABLE_PTR(p, CODE) \
436 do { \
437 spEntry *p; \
438 spEntry *__end_ptr = &stable_ptr_table[SPT_size]; \
439 for (p = stable_ptr_table; p < __end_ptr; p++) { \
440 /* Internal pointers are free slots. NULL is last in free */ \
441 /* list. */ \
442 if (p->addr && \
443 (p->addr < (P_)stable_ptr_table || p->addr >= (P_)__end_ptr)) \
444 { \
445 do { CODE } while(0); \
446 } \
447 } \
448 } while(0)
449
450 #define FOR_EACH_STABLE_NAME(p, CODE) \
451 do { \
452 snEntry *p; \
453 snEntry *__end_ptr = &stable_name_table[SNT_size]; \
454 for (p = stable_name_table + 1; p < __end_ptr; p++) { \
455 /* Internal pointers are free slots. */ \
456 /* If p->addr == NULL, it's a */ \
457 /* stable name where the object has been GC'd, but the */ \
458 /* StableName object (sn_obj) is still alive. */ \
459 if ((p->addr < (P_)stable_name_table || \
460 p->addr >= (P_)__end_ptr)) \
461 { \
462 /* NOTE: There is an ambiguity here if p->addr == NULL */ \
463 /* it is either the last item in the free list or it */ \
464 /* is a stable name whose pointee died. sn_obj == NULL */ \
465 /* disambiguates as last free list item. */ \
466 do { CODE } while(0); \
467 } \
468 } \
469 } while(0)
470
471 STATIC_INLINE void
472 markStablePtrTable(evac_fn evac, void *user)
473 {
474 FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
475 }
476
477 STATIC_INLINE void
478 rememberOldStableNameAddresses(void)
479 {
480 /* TODO: Only if !full GC */
481 FOR_EACH_STABLE_NAME(p, p->old = p->addr;);
482 }
483
484 void
485 markStableTables(evac_fn evac, void *user)
486 {
487 /* Since no other thread can currently be dereferencing a stable pointer, it
488 * is safe to free the old versions of the table.
489 */
490 freeOldSPTs();
491
492 markStablePtrTable(evac, user);
493 rememberOldStableNameAddresses();
494 }
495
496 /* -----------------------------------------------------------------------------
497 * Thread the stable pointer table for compacting GC.
498 *
499 * Here we must call the supplied evac function for each pointer into
500 * the heap from the stable tables, because the compacting
501 * collector may move the object it points to.
502 * -------------------------------------------------------------------------- */
503
504 STATIC_INLINE void
505 threadStableNameTable( evac_fn evac, void *user )
506 {
507 FOR_EACH_STABLE_NAME(p, {
508 if (p->sn_obj != NULL) {
509 evac(user, (StgClosure **)&p->sn_obj);
510 }
511 if (p->addr != NULL) {
512 evac(user, (StgClosure **)&p->addr);
513 }
514 });
515 }
516
517 STATIC_INLINE void
518 threadStablePtrTable( evac_fn evac, void *user )
519 {
520 FOR_EACH_STABLE_PTR(p, evac(user, (StgClosure **)&p->addr););
521 }
522
523 void
524 threadStableTables( evac_fn evac, void *user )
525 {
526 threadStableNameTable(evac, user);
527 threadStablePtrTable(evac, user);
528 }
529
530 /* -----------------------------------------------------------------------------
531 * Garbage collect any dead entries in the stable name table.
532 *
533 * A dead entry has:
534 *
535 * - a zero reference count
536 * - a dead sn_obj
537 *
538 * Both of these conditions must be true in order to re-use the stable
539 * name table entry. We can re-use stable name table entries for live
540 * heap objects, as long as the program has no StableName objects that
541 * refer to the entry.
542 * -------------------------------------------------------------------------- */
543
544 void
545 gcStableTables( void )
546 {
547 FOR_EACH_STABLE_NAME(
548 p, {
549 // FOR_EACH_STABLE_NAME traverses free entries too, so
550 // check sn_obj
551 if (p->sn_obj != NULL) {
552 // Update the pointer to the StableName object, if there is one
553 p->sn_obj = isAlive(p->sn_obj);
554 if (p->sn_obj == NULL) {
555 // StableName object died
556 debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
557 (long)(p - stable_name_table), p->addr);
558 freeSnEntry(p);
559 } else if (p->addr != NULL) {
560 // sn_obj is alive, update pointee
561 p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
562 if (p->addr == NULL) {
563 // Pointee died
564 debugTrace(DEBUG_stable, "GC'd pointee %ld",
565 (long)(p - stable_name_table));
566 }
567 }
568 }
569 });
570 }
571
572 /* -----------------------------------------------------------------------------
573 * Update the StableName hash table
574 *
575 * The boolean argument 'full' indicates that a major collection is
576 * being done, so we might as well throw away the hash table and build
577 * a new one. For a minor collection, we just re-hash the elements
578 * that changed.
579 * -------------------------------------------------------------------------- */
580
581 void
582 updateStableTables(bool full)
583 {
584 if (full && addrToStableHash != NULL && 0 != keyCountHashTable(addrToStableHash)) {
585 freeHashTable(addrToStableHash,NULL);
586 addrToStableHash = allocHashTable();
587 }
588
589 if(full) {
590 FOR_EACH_STABLE_NAME(
591 p, {
592 if (p->addr != NULL) {
593 // Target still alive, Re-hash this stable name
594 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
595 }
596 });
597 } else {
598 FOR_EACH_STABLE_NAME(
599 p, {
600 if (p->addr != p->old) {
601 removeHashTable(addrToStableHash, (W_)p->old, NULL);
602 /* Movement happened: */
603 if (p->addr != NULL) {
604 insertHashTable(addrToStableHash, (W_)p->addr, (void *)(p - stable_name_table));
605 }
606 }
607 });
608 }
609 }