1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
13 #include "OSThreads.h"
15 #include "BlockAlloc.h"
17 #include "GCCompact.h"
22 // Turn off inlining when debugging - it obfuscates things
25 # define STATIC_INLINE static
28 /* -----------------------------------------------------------------------------
29 Threading / unthreading pointers.
31 The basic idea here is to chain together all the fields pointing at
32 a particular object, with the root of the chain in the object's
33 info table field. The original contents of the info pointer goes
34 at the end of the chain.
36 Adding a new field to the chain is a matter of swapping the
37 contents of the field with the contents of the object's info table
40 To unthread the chain, we walk down it updating all the fields on
41 the chain with the new location of the object. We stop when we
42 reach the info pointer at the end.
44 We use a trick to identify the info pointer: when swapping pointers
45 for threading, we set the low bit of the original pointer, with the
46 result that all the pointers in the chain have their low bits set
47 except for the info pointer.
48 -------------------------------------------------------------------------- */
51 thread (StgClosure **p)
53 StgPtr q = *(StgPtr *)p;
56 // It doesn't look like a closure at the moment, because the info
57 // ptr is possibly threaded:
58 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
60 if (HEAP_ALLOCED(q)) {
62 // a handy way to discover whether the ptr is into the
63 // compacted area of the old gen, is that the EVACUATED flag
64 // is zero (it's non-zero for all the other areas of live
66 if ((bd->flags & BF_EVACUATED) == 0) {
68 *(StgPtr)p = (StgWord)*q;
69 *q = (StgWord)p + 1; // set the low bit
74 // This version of thread() takes a (void *), used to circumvent
75 // warnings from gcc about pointer punning and strict aliasing.
76 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
79 unthread( StgPtr p, StgPtr free )
83 while ((q & 1) != 0) {
84 q -= 1; // unset the low bit again
86 *((StgPtr)q) = (StgWord)free;
92 STATIC_INLINE StgInfoTable *
93 get_threaded_info( StgPtr p )
95 StgPtr q = (P_)GET_INFO((StgClosure *)p);
97 while (((StgWord)q & 1) != 0) {
98 q = (P_)*((StgPtr)((StgWord)q-1));
101 ASSERT(LOOKS_LIKE_INFO_PTR(q));
102 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
105 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
106 // Remember, the two regions *might* overlap, but: to <= from.
108 move(StgPtr to, StgPtr from, nat size)
110 for(; size > 0; --size) {
116 thread_static( StgClosure* p )
118 const StgInfoTable *info;
120 // keep going until we've threaded all the objects on the linked
122 while (p != END_OF_STATIC_LIST) {
125 switch (info->type) {
128 thread(&((StgInd *)p)->indirectee);
129 p = *IND_STATIC_LINK(p);
133 p = *THUNK_STATIC_LINK(p);
136 p = *FUN_STATIC_LINK(p);
139 p = *STATIC_LINK(info,p);
143 barf("thread_static: strange closure %d", (int)(info->type));
150 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
156 bitmap = large_bitmap->bitmap[b];
157 for (i = 0; i < size; ) {
158 if ((bitmap & 1) == 0) {
159 thread((StgClosure **)p);
163 if (i % BITS_IN(W_) == 0) {
165 bitmap = large_bitmap->bitmap[b];
167 bitmap = bitmap >> 1;
173 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
180 switch (fun_info->f.fun_type) {
182 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
183 size = BITMAP_SIZE(fun_info->f.b.bitmap);
186 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
187 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
191 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
192 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
195 if ((bitmap & 1) == 0) {
196 thread((StgClosure **)p);
199 bitmap = bitmap >> 1;
208 thread_stack(StgPtr p, StgPtr stack_end)
210 const StgRetInfoTable* info;
214 // highly similar to scavenge_stack, but we do pointer threading here.
216 while (p < stack_end) {
218 // *p must be the info pointer of an activation
219 // record. All activation records have 'bitmap' style layout
222 info = get_ret_itbl((StgClosure *)p);
224 switch (info->i.type) {
226 // Dynamic bitmap: the mask is stored on the stack
230 dyn = ((StgRetDyn *)p)->liveness;
232 // traverse the bitmap first
233 bitmap = RET_DYN_LIVENESS(dyn);
234 p = (P_)&((StgRetDyn *)p)->payload[0];
235 size = RET_DYN_BITMAP_SIZE;
237 if ((bitmap & 1) == 0) {
238 thread((StgClosure **)p);
241 bitmap = bitmap >> 1;
245 // skip over the non-ptr words
246 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
248 // follow the ptr words
249 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
250 thread((StgClosure **)p);
256 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
257 case CATCH_RETRY_FRAME:
258 case CATCH_STM_FRAME:
259 case ATOMICALLY_FRAME:
265 bitmap = BITMAP_BITS(info->i.layout.bitmap);
266 size = BITMAP_SIZE(info->i.layout.bitmap);
268 // NOTE: the payload starts immediately after the info-ptr, we
269 // don't have an StgHeader in the same sense as a heap closure.
271 if ((bitmap & 1) == 0) {
272 thread((StgClosure **)p);
275 bitmap = bitmap >> 1;
286 thread((StgClosure **)p);
288 size = BCO_BITMAP_SIZE(bco);
289 thread_large_bitmap(p, BCO_BITMAP(bco), size);
294 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
298 size = GET_LARGE_BITMAP(&info->i)->size;
299 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
305 StgRetFun *ret_fun = (StgRetFun *)p;
306 StgFunInfoTable *fun_info;
308 fun_info = itbl_to_fun_itbl(
309 get_threaded_info((StgPtr)ret_fun->fun));
310 // *before* threading it!
311 thread(&ret_fun->fun);
312 p = thread_arg_block(fun_info, ret_fun->payload);
317 barf("thread_stack: weird activation record found on stack: %d",
318 (int)(info->i.type));
324 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
328 StgFunInfoTable *fun_info;
330 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
331 ASSERT(fun_info->i.type != PAP);
335 switch (fun_info->f.fun_type) {
337 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
340 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
344 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
348 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
351 if ((bitmap & 1) == 0) {
352 thread((StgClosure **)p);
355 bitmap = bitmap >> 1;
365 thread_PAP (StgPAP *pap)
368 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
374 thread_AP (StgAP *ap)
377 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
383 thread_AP_STACK (StgAP_STACK *ap)
386 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
387 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
391 thread_TSO (StgTSO *tso)
394 thread_(&tso->global_link);
396 if ( tso->why_blocked == BlockedOnMVar
397 || tso->why_blocked == BlockedOnBlackHole
398 || tso->why_blocked == BlockedOnException
400 || tso->why_blocked == BlockedOnGA
401 || tso->why_blocked == BlockedOnGA_NoSend
404 thread_(&tso->block_info.closure);
406 thread_(&tso->blocked_exceptions);
410 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
411 return (StgPtr)tso + tso_sizeW(tso);
416 update_fwd_large( bdescr *bd )
419 const StgInfoTable* info;
421 for (; bd != NULL; bd = bd->link) {
424 info = get_itbl((StgClosure *)p);
426 switch (info->type) {
432 case MUT_ARR_PTRS_CLEAN:
433 case MUT_ARR_PTRS_DIRTY:
434 case MUT_ARR_PTRS_FROZEN:
435 case MUT_ARR_PTRS_FROZEN0:
440 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
441 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
442 thread((StgClosure **)p);
448 thread_TSO((StgTSO *)p);
452 thread_AP_STACK((StgAP_STACK *)p);
456 thread_PAP((StgPAP *)p);
462 StgTRecChunk *tc = (StgTRecChunk *)p;
463 TRecEntry *e = &(tc -> entries[0]);
464 thread_(&tc->prev_chunk);
465 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
467 thread(&e->expected_value);
468 thread(&e->new_value);
474 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
480 thread_obj (StgInfoTable *info, StgPtr p)
482 switch (info->type) {
484 return p + sizeofW(StgThunk) + 1;
488 return p + sizeofW(StgHeader) + 1;
492 thread(&((StgClosure *)p)->payload[0]);
493 return p + sizeofW(StgHeader) + 1;
496 thread(&((StgThunk *)p)->payload[0]);
497 return p + sizeofW(StgThunk) + 1;
500 return p + sizeofW(StgThunk) + 2;
504 return p + sizeofW(StgHeader) + 2;
507 thread(&((StgThunk *)p)->payload[0]);
508 return p + sizeofW(StgThunk) + 2;
512 thread(&((StgClosure *)p)->payload[0]);
513 return p + sizeofW(StgHeader) + 2;
516 thread(&((StgThunk *)p)->payload[0]);
517 thread(&((StgThunk *)p)->payload[1]);
518 return p + sizeofW(StgThunk) + 2;
522 thread(&((StgClosure *)p)->payload[0]);
523 thread(&((StgClosure *)p)->payload[1]);
524 return p + sizeofW(StgHeader) + 2;
527 StgBCO *bco = (StgBCO *)p;
528 thread_(&bco->instrs);
529 thread_(&bco->literals);
531 thread_(&bco->itbls);
532 return p + bco_sizeW(bco);
539 end = (P_)((StgThunk *)p)->payload +
540 info->layout.payload.ptrs;
541 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
542 thread((StgClosure **)p);
544 return p + info->layout.payload.nptrs;
554 case SE_CAF_BLACKHOLE:
560 end = (P_)((StgClosure *)p)->payload +
561 info->layout.payload.ptrs;
562 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
563 thread((StgClosure **)p);
565 return p + info->layout.payload.nptrs;
570 StgWeak *w = (StgWeak *)p;
573 thread(&w->finalizer);
574 if (w->link != NULL) {
577 return p + sizeofW(StgWeak);
582 StgMVar *mvar = (StgMVar *)p;
583 thread_(&mvar->head);
584 thread_(&mvar->tail);
585 thread(&mvar->value);
586 return p + sizeofW(StgMVar);
590 case IND_OLDGEN_PERM:
591 thread(&((StgInd *)p)->indirectee);
592 return p + sizeofW(StgInd);
596 StgSelector *s = (StgSelector *)p;
597 thread(&s->selectee);
598 return p + THUNK_SELECTOR_sizeW();
602 return thread_AP_STACK((StgAP_STACK *)p);
605 return thread_PAP((StgPAP *)p);
608 return thread_AP((StgAP *)p);
611 return p + arr_words_sizeW((StgArrWords *)p);
613 case MUT_ARR_PTRS_CLEAN:
614 case MUT_ARR_PTRS_DIRTY:
615 case MUT_ARR_PTRS_FROZEN:
616 case MUT_ARR_PTRS_FROZEN0:
621 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
622 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
623 thread((StgClosure **)p);
629 return thread_TSO((StgTSO *)p);
631 case TVAR_WAIT_QUEUE:
633 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
634 thread_(&wq->waiting_tso);
635 thread_(&wq->next_queue_entry);
636 thread_(&wq->prev_queue_entry);
637 return p + sizeofW(StgTVarWaitQueue);
642 StgTVar *tvar = (StgTVar *)p;
643 thread((void *)&tvar->current_value);
644 thread((void *)&tvar->first_wait_queue_entry);
645 return p + sizeofW(StgTVar);
650 StgTRecHeader *trec = (StgTRecHeader *)p;
651 thread_(&trec->enclosing_trec);
652 thread_(&trec->current_chunk);
653 return p + sizeofW(StgTRecHeader);
659 StgTRecChunk *tc = (StgTRecChunk *)p;
660 TRecEntry *e = &(tc -> entries[0]);
661 thread_(&tc->prev_chunk);
662 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
664 thread(&e->expected_value);
665 thread(&e->new_value);
667 return p + sizeofW(StgTRecChunk);
671 barf("update_fwd: unknown/strange object %d", (int)(info->type));
677 update_fwd( bdescr *blocks )
686 barf("update_fwd: ToDo");
689 // cycle through all the blocks in the step
690 for (; bd != NULL; bd = bd->link) {
693 // linearly scan the objects in this block
694 while (p < bd->free) {
695 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
696 info = get_itbl((StgClosure *)p);
697 p = thread_obj(info, p);
703 update_fwd_compact( bdescr *blocks )
709 bdescr *bd, *free_bd;
715 free = free_bd->start;
718 barf("update_fwd: ToDo");
721 // cycle through all the blocks in the step
722 for (; bd != NULL; bd = bd->link) {
725 while (p < bd->free ) {
727 while ( p < bd->free && !is_marked(p,bd) ) {
736 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
737 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
739 while ( p < bd->free ) {
744 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
752 // Problem: we need to know the destination for this cell
753 // in order to unthread its info pointer. But we can't
754 // know the destination without the size, because we may
755 // spill into the next block. So we have to run down the
756 // threaded list and get the info ptr first.
757 info = get_threaded_info(p);
761 p = thread_obj(info, p);
764 if (free + size > free_bd->start + BLOCK_SIZE_W) {
765 // unset the next bit in the bitmap to indicate that
766 // this object needs to be pushed into the next
767 // block. This saves us having to run down the
768 // threaded info pointer list twice during the next pass.
770 free_bd = free_bd->link;
771 free = free_bd->start;
773 ASSERT(is_marked(q+1,bd));
786 update_bkwd_compact( step *stp )
792 bdescr *bd, *free_bd;
794 nat size, free_blocks;
796 bd = free_bd = stp->old_blocks;
797 free = free_bd->start;
801 barf("update_bkwd: ToDo");
804 // cycle through all the blocks in the step
805 for (; bd != NULL; bd = bd->link) {
808 while (p < bd->free ) {
810 while ( p < bd->free && !is_marked(p,bd) ) {
819 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
820 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
822 while ( p < bd->free ) {
827 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
835 if (!is_marked(p+1,bd)) {
836 // don't forget to update the free ptr in the block desc.
837 free_bd->free = free;
838 free_bd = free_bd->link;
839 free = free_bd->start;
844 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
845 info = get_itbl((StgClosure *)p);
846 size = closure_sizeW_((StgClosure *)p,info);
853 if (info->type == TSO) {
854 move_TSO((StgTSO *)p, (StgTSO *)free);
865 // free the remaining blocks and count what's left.
866 free_bd->free = free;
867 if (free_bd->link != NULL) {
868 freeChain(free_bd->link);
869 free_bd->link = NULL;
876 compact( void (*get_roots)(evac_fn) )
881 // 1. thread the roots
882 get_roots((evac_fn)thread);
884 // the weak pointer lists...
885 if (weak_ptr_list != NULL) {
886 thread((void *)&weak_ptr_list);
888 if (old_weak_ptr_list != NULL) {
889 thread((void *)&old_weak_ptr_list); // tmp
893 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
896 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
897 for (p = bd->start; p < bd->free; p++) {
898 thread((StgClosure **)p);
903 // the global thread list
904 thread((void *)&all_threads);
906 // any threads resurrected during this GC
907 thread((void *)&resurrected_threads);
912 for (task = all_tasks; task != NULL; task = task->all_link) {
919 // the static objects
920 thread_static(scavenged_static_objects);
922 // the stable pointer table
923 threadStablePtrTable((evac_fn)thread);
925 // the CAF list (used by GHCi)
926 markCAFs((evac_fn)thread);
928 // 2. update forward ptrs
929 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
930 for (s = 0; s < generations[g].n_steps; s++) {
931 if (g==0 && s ==0) continue;
932 stp = &generations[g].steps[s];
933 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
934 stp->gen->no, stp->no);
936 update_fwd(stp->blocks);
937 update_fwd_large(stp->scavenged_large_objects);
938 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
939 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
940 stp->gen->no, stp->no);
941 update_fwd_compact(stp->old_blocks);
946 // 3. update backward ptrs
947 stp = &oldest_gen->steps[0];
948 if (stp->old_blocks != NULL) {
949 blocks = update_bkwd_compact(stp);
951 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
952 stp->gen->no, stp->no,
953 stp->n_old_blocks, blocks);
954 stp->n_old_blocks = blocks;