1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
14 #include "BlockAlloc.h"
16 #include "GCCompact.h"
20 // Turn off inlining when debugging - it obfuscates things
23 # define STATIC_INLINE static
26 /* -----------------------------------------------------------------------------
27 Threading / unthreading pointers.
29 The basic idea here is to chain together all the fields pointing at
30 a particular object, with the root of the chain in the object's
31 info table field. The original contents of the info pointer goes
32 at the end of the chain.
34 Adding a new field to the chain is a matter of swapping the
35 contents of the field with the contents of the object's info table
38 To unthread the chain, we walk down it updating all the fields on
39 the chain with the new location of the object. We stop when we
40 reach the info pointer at the end.
42 We use a trick to identify the info pointer: when swapping pointers
43 for threading, we set the low bit of the original pointer, with the
44 result that all the pointers in the chain have their low bits set
45 except for the info pointer.
46 -------------------------------------------------------------------------- */
51 StgPtr q = (StgPtr)*p;
54 // It doesn't look like a closure at the moment, because the info
55 // ptr is possibly threaded:
56 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
58 if (HEAP_ALLOCED(q)) {
60 // a handy way to discover whether the ptr is into the
61 // compacted area of the old gen, is that the EVACUATED flag
62 // is zero (it's non-zero for all the other areas of live
64 if ((bd->flags & BF_EVACUATED) == 0) {
66 *q = (StgWord)p + 1; // set the low bit
72 unthread( StgPtr p, StgPtr free )
76 while ((q & 1) != 0) {
77 q -= 1; // unset the low bit again
79 *((StgPtr)q) = (StgWord)free;
85 STATIC_INLINE StgInfoTable *
86 get_threaded_info( StgPtr p )
88 StgPtr q = (P_)GET_INFO((StgClosure *)p);
90 while (((StgWord)q & 1) != 0) {
91 q = (P_)*((StgPtr)((StgWord)q-1));
94 ASSERT(LOOKS_LIKE_INFO_PTR(q));
95 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
98 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
99 // Remember, the two regions *might* overlap, but: to <= from.
101 move(StgPtr to, StgPtr from, nat size)
103 for(; size > 0; --size) {
109 obj_sizeW( StgClosure *p, StgInfoTable *info )
111 switch (info->type) {
118 return sizeofW(StgHeader) + 1;
128 return sizeofW(StgHeader) + 2;
130 return THUNK_SELECTOR_sizeW();
132 return ap_stack_sizeW((StgAP_STACK *)p);
135 return pap_sizeW((StgPAP *)p);
137 return arr_words_sizeW((StgArrWords *)p);
139 case MUT_ARR_PTRS_FROZEN:
140 case MUT_ARR_PTRS_FROZEN0:
141 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
143 return tso_sizeW((StgTSO *)p);
145 return bco_sizeW((StgBCO *)p);
146 case TVAR_WAIT_QUEUE:
147 return sizeofW(StgTVarWaitQueue);
149 return sizeofW(StgTVar);
151 return sizeofW(StgTRecChunk);
153 return sizeofW(StgTRecHeader);
155 return sizeW_fromITBL(info);
160 thread_static( StgClosure* p )
162 const StgInfoTable *info;
164 // keep going until we've threaded all the objects on the linked
166 while (p != END_OF_STATIC_LIST) {
169 switch (info->type) {
172 thread((StgPtr)&((StgInd *)p)->indirectee);
173 p = IND_STATIC_LINK(p);
177 p = THUNK_STATIC_LINK(p);
180 p = FUN_STATIC_LINK(p);
183 p = STATIC_LINK(info,p);
187 barf("thread_static: strange closure %d", (int)(info->type));
194 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
200 bitmap = large_bitmap->bitmap[b];
201 for (i = 0; i < size; ) {
202 if ((bitmap & 1) == 0) {
207 if (i % BITS_IN(W_) == 0) {
209 bitmap = large_bitmap->bitmap[b];
211 bitmap = bitmap >> 1;
217 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
224 switch (fun_info->f.fun_type) {
226 bitmap = BITMAP_BITS(fun_info->f.bitmap);
227 size = BITMAP_SIZE(fun_info->f.bitmap);
230 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
231 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
235 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
236 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
239 if ((bitmap & 1) == 0) {
243 bitmap = bitmap >> 1;
252 thread_stack(StgPtr p, StgPtr stack_end)
254 const StgRetInfoTable* info;
258 // highly similar to scavenge_stack, but we do pointer threading here.
260 while (p < stack_end) {
262 // *p must be the info pointer of an activation
263 // record. All activation records have 'bitmap' style layout
266 info = get_ret_itbl((StgClosure *)p);
268 switch (info->i.type) {
270 // Dynamic bitmap: the mask is stored on the stack
274 dyn = ((StgRetDyn *)p)->liveness;
276 // traverse the bitmap first
277 bitmap = RET_DYN_LIVENESS(dyn);
278 p = (P_)&((StgRetDyn *)p)->payload[0];
279 size = RET_DYN_BITMAP_SIZE;
281 if ((bitmap & 1) == 0) {
285 bitmap = bitmap >> 1;
289 // skip over the non-ptr words
290 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
292 // follow the ptr words
293 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
300 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
301 case CATCH_RETRY_FRAME:
302 case CATCH_STM_FRAME:
303 case ATOMICALLY_FRAME:
309 bitmap = BITMAP_BITS(info->i.layout.bitmap);
310 size = BITMAP_SIZE(info->i.layout.bitmap);
312 // NOTE: the payload starts immediately after the info-ptr, we
313 // don't have an StgHeader in the same sense as a heap closure.
315 if ((bitmap & 1) == 0) {
319 bitmap = bitmap >> 1;
332 size = BCO_BITMAP_SIZE(bco);
333 thread_large_bitmap(p, BCO_BITMAP(bco), size);
338 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
342 size = GET_LARGE_BITMAP(&info->i)->size;
343 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
349 StgRetFun *ret_fun = (StgRetFun *)p;
350 StgFunInfoTable *fun_info;
352 fun_info = itbl_to_fun_itbl(
353 get_threaded_info((StgPtr)ret_fun->fun));
354 // *before* threading it!
355 thread((StgPtr)&ret_fun->fun);
356 p = thread_arg_block(fun_info, ret_fun->payload);
361 barf("thread_stack: weird activation record found on stack: %d",
362 (int)(info->i.type));
368 thread_PAP (StgPAP *pap)
371 StgWord bitmap, size;
372 StgFunInfoTable *fun_info;
374 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
375 ASSERT(fun_info->i.type != PAP);
377 p = (StgPtr)pap->payload;
380 switch (fun_info->f.fun_type) {
382 bitmap = BITMAP_BITS(fun_info->f.bitmap);
385 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
389 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
393 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
397 if ((bitmap & 1) == 0) {
401 bitmap = bitmap >> 1;
407 thread((StgPtr)&pap->fun);
412 thread_AP_STACK (StgAP_STACK *ap)
414 thread((StgPtr)&ap->fun);
415 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
416 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
420 thread_TSO (StgTSO *tso)
422 thread((StgPtr)&tso->link);
423 thread((StgPtr)&tso->global_link);
425 if ( tso->why_blocked == BlockedOnMVar
426 || tso->why_blocked == BlockedOnBlackHole
427 || tso->why_blocked == BlockedOnException
429 || tso->why_blocked == BlockedOnGA
430 || tso->why_blocked == BlockedOnGA_NoSend
433 thread((StgPtr)&tso->block_info.closure);
435 if ( tso->blocked_exceptions != NULL ) {
436 thread((StgPtr)&tso->blocked_exceptions);
439 thread((StgPtr)&tso->trec);
441 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
442 return (StgPtr)tso + tso_sizeW(tso);
447 update_fwd_large( bdescr *bd )
450 const StgInfoTable* info;
452 for (; bd != NULL; bd = bd->link) {
455 info = get_itbl((StgClosure *)p);
457 switch (info->type) {
464 case MUT_ARR_PTRS_FROZEN:
465 case MUT_ARR_PTRS_FROZEN0:
470 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
471 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
478 thread_TSO((StgTSO *)p);
482 thread_AP_STACK((StgAP_STACK *)p);
486 thread_PAP((StgPAP *)p);
490 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
496 thread_obj (StgInfoTable *info, StgPtr p)
498 switch (info->type) {
502 return p + sizeofW(StgHeader) + 1;
506 thread((StgPtr)&((StgClosure *)p)->payload[0]);
507 return p + sizeofW(StgHeader) + 1;
510 thread((StgPtr)&((StgClosure *)p)->payload[0]);
511 return p + sizeofW(StgHeader) + 1;
516 return p + sizeofW(StgHeader) + 2;
521 thread((StgPtr)&((StgClosure *)p)->payload[0]);
522 return p + sizeofW(StgHeader) + 2;
527 thread((StgPtr)&((StgClosure *)p)->payload[0]);
528 thread((StgPtr)&((StgClosure *)p)->payload[1]);
529 return p + sizeofW(StgHeader) + 2;
532 StgBCO *bco = (StgBCO *)p;
533 thread((StgPtr)&bco->instrs);
534 thread((StgPtr)&bco->literals);
535 thread((StgPtr)&bco->ptrs);
536 thread((StgPtr)&bco->itbls);
537 return p + bco_sizeW(bco);
548 case SE_CAF_BLACKHOLE:
555 end = (P_)((StgClosure *)p)->payload +
556 info->layout.payload.ptrs;
557 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
560 return p + info->layout.payload.nptrs;
565 StgWeak *w = (StgWeak *)p;
566 thread((StgPtr)&w->key);
567 thread((StgPtr)&w->value);
568 thread((StgPtr)&w->finalizer);
569 if (w->link != NULL) {
570 thread((StgPtr)&w->link);
572 return p + sizeofW(StgWeak);
577 StgMVar *mvar = (StgMVar *)p;
578 thread((StgPtr)&mvar->head);
579 thread((StgPtr)&mvar->tail);
580 thread((StgPtr)&mvar->value);
581 return p + sizeofW(StgMVar);
585 case IND_OLDGEN_PERM:
586 thread((StgPtr)&((StgInd *)p)->indirectee);
587 return p + sizeofW(StgInd);
591 StgSelector *s = (StgSelector *)p;
592 thread((StgPtr)&s->selectee);
593 return p + THUNK_SELECTOR_sizeW();
597 return thread_AP_STACK((StgAP_STACK *)p);
601 return thread_PAP((StgPAP *)p);
604 return p + arr_words_sizeW((StgArrWords *)p);
607 case MUT_ARR_PTRS_FROZEN:
608 case MUT_ARR_PTRS_FROZEN0:
613 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
614 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
621 return thread_TSO((StgTSO *)p);
623 case TVAR_WAIT_QUEUE:
625 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
626 thread((StgPtr)&wq->waiting_tso);
627 thread((StgPtr)&wq->next_queue_entry);
628 thread((StgPtr)&wq->prev_queue_entry);
629 return p + sizeofW(StgTVarWaitQueue);
634 StgTVar *tvar = (StgTVar *)p;
635 thread((StgPtr)&tvar->current_value);
636 thread((StgPtr)&tvar->first_wait_queue_entry);
637 return p + sizeofW(StgTVar);
642 StgTRecHeader *trec = (StgTRecHeader *)p;
643 thread((StgPtr)&trec->enclosing_trec);
644 thread((StgPtr)&trec->current_chunk);
645 return p + sizeofW(StgTRecHeader);
651 StgTRecChunk *tc = (StgTRecChunk *)p;
652 TRecEntry *e = &(tc -> entries[0]);
653 thread((StgPtr)&tc->prev_chunk);
654 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
655 thread((StgPtr)&e->tvar);
656 thread((StgPtr)&e->expected_value);
657 thread((StgPtr)&e->new_value);
659 return p + sizeofW(StgTRecChunk);
663 barf("update_fwd: unknown/strange object %d", (int)(info->type));
669 update_fwd( bdescr *blocks )
678 barf("update_fwd: ToDo");
681 // cycle through all the blocks in the step
682 for (; bd != NULL; bd = bd->link) {
685 // linearly scan the objects in this block
686 while (p < bd->free) {
687 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
688 info = get_itbl((StgClosure *)p);
689 p = thread_obj(info, p);
695 update_fwd_compact( bdescr *blocks )
701 bdescr *bd, *free_bd;
707 free = free_bd->start;
710 barf("update_fwd: ToDo");
713 // cycle through all the blocks in the step
714 for (; bd != NULL; bd = bd->link) {
717 while (p < bd->free ) {
719 while ( p < bd->free && !is_marked(p,bd) ) {
728 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
729 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
731 while ( p < bd->free ) {
736 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
744 // Problem: we need to know the destination for this cell
745 // in order to unthread its info pointer. But we can't
746 // know the destination without the size, because we may
747 // spill into the next block. So we have to run down the
748 // threaded list and get the info ptr first.
749 info = get_threaded_info(p);
753 p = thread_obj(info, p);
756 if (free + size > free_bd->start + BLOCK_SIZE_W) {
757 // unset the next bit in the bitmap to indicate that
758 // this object needs to be pushed into the next
759 // block. This saves us having to run down the
760 // threaded info pointer list twice during the next pass.
762 free_bd = free_bd->link;
763 free = free_bd->start;
765 ASSERT(is_marked(q+1,bd));
778 update_bkwd_compact( step *stp )
784 bdescr *bd, *free_bd;
786 nat size, free_blocks;
788 bd = free_bd = stp->blocks;
789 free = free_bd->start;
793 barf("update_bkwd: ToDo");
796 // cycle through all the blocks in the step
797 for (; bd != NULL; bd = bd->link) {
800 while (p < bd->free ) {
802 while ( p < bd->free && !is_marked(p,bd) ) {
811 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
812 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
814 while ( p < bd->free ) {
819 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
827 if (!is_marked(p+1,bd)) {
828 // don't forget to update the free ptr in the block desc.
829 free_bd->free = free;
830 free_bd = free_bd->link;
831 free = free_bd->start;
836 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
837 info = get_itbl((StgClosure *)p);
838 size = obj_sizeW((StgClosure *)p,info);
844 // Rebuild the mutable list for the old generation.
845 if (ip_MUTABLE(info)) {
846 recordMutable((StgClosure *)free);
850 if (info->type == TSO) {
851 move_TSO((StgTSO *)p, (StgTSO *)free);
862 // free the remaining blocks and count what's left.
863 free_bd->free = free;
864 if (free_bd->link != NULL) {
865 freeChain(free_bd->link);
866 free_bd->link = NULL;
868 stp->n_blocks = free_blocks;
874 compact( void (*get_roots)(evac_fn) )
879 // 1. thread the roots
880 get_roots((evac_fn)thread);
882 // the weak pointer lists...
883 if (weak_ptr_list != NULL) {
884 thread((StgPtr)&weak_ptr_list);
886 if (old_weak_ptr_list != NULL) {
887 thread((StgPtr)&old_weak_ptr_list); // tmp
891 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
894 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
895 for (p = bd->start; p < bd->free; p++) {
901 // the global thread list
902 thread((StgPtr)&all_threads);
904 // any threads resurrected during this GC
905 thread((StgPtr)&resurrected_threads);
907 // the main threads list
910 for (m = main_threads; m != NULL; m = m->link) {
911 thread((StgPtr)&m->tso);
915 // the static objects
916 thread_static(scavenged_static_objects);
918 // the stable pointer table
919 threadStablePtrTable((evac_fn)thread);
921 // the CAF list (used by GHCi)
922 markCAFs((evac_fn)thread);
924 // 2. update forward ptrs
925 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
926 for (s = 0; s < generations[g].n_steps; s++) {
927 stp = &generations[g].steps[s];
928 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
930 update_fwd(stp->to_blocks);
931 update_fwd_large(stp->scavenged_large_objects);
932 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
933 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
934 update_fwd_compact(stp->blocks);
939 // 3. update backward ptrs
940 stp = &oldest_gen->steps[0];
941 if (stp->blocks != NULL) {
942 blocks = update_bkwd_compact(stp);
943 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
944 stp->gen->no, stp->no,
945 stp->n_blocks, blocks););
946 stp->n_blocks = blocks;