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"
21 // Turn off inlining when debugging - it obfuscates things
24 # define STATIC_INLINE static
27 /* -----------------------------------------------------------------------------
28 Threading / unthreading pointers.
30 The basic idea here is to chain together all the fields pointing at
31 a particular object, with the root of the chain in the object's
32 info table field. The original contents of the info pointer goes
33 at the end of the chain.
35 Adding a new field to the chain is a matter of swapping the
36 contents of the field with the contents of the object's info table
39 To unthread the chain, we walk down it updating all the fields on
40 the chain with the new location of the object. We stop when we
41 reach the info pointer at the end.
43 We use a trick to identify the info pointer: when swapping pointers
44 for threading, we set the low bit of the original pointer, with the
45 result that all the pointers in the chain have their low bits set
46 except for the info pointer.
47 -------------------------------------------------------------------------- */
52 StgPtr q = (StgPtr)*p;
55 // It doesn't look like a closure at the moment, because the info
56 // ptr is possibly threaded:
57 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
59 if (HEAP_ALLOCED(q)) {
61 // a handy way to discover whether the ptr is into the
62 // compacted area of the old gen, is that the EVACUATED flag
63 // is zero (it's non-zero for all the other areas of live
65 if ((bd->flags & BF_EVACUATED) == 0) {
67 *q = (StgWord)p + 1; // set the low bit
73 unthread( StgPtr p, StgPtr free )
77 while ((q & 1) != 0) {
78 q -= 1; // unset the low bit again
80 *((StgPtr)q) = (StgWord)free;
86 STATIC_INLINE StgInfoTable *
87 get_threaded_info( StgPtr p )
89 StgPtr q = (P_)GET_INFO((StgClosure *)p);
91 while (((StgWord)q & 1) != 0) {
92 q = (P_)*((StgPtr)((StgWord)q-1));
95 ASSERT(LOOKS_LIKE_INFO_PTR(q));
96 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
99 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
100 // Remember, the two regions *might* overlap, but: to <= from.
102 move(StgPtr to, StgPtr from, nat size)
104 for(; size > 0; --size) {
110 obj_sizeW( StgClosure *p, StgInfoTable *info )
112 switch (info->type) {
119 return sizeofW(StgHeader) + 1;
129 return sizeofW(StgHeader) + 2;
131 return THUNK_SELECTOR_sizeW();
133 return ap_stack_sizeW((StgAP_STACK *)p);
136 return pap_sizeW((StgPAP *)p);
138 return arr_words_sizeW((StgArrWords *)p);
140 case MUT_ARR_PTRS_FROZEN:
141 case MUT_ARR_PTRS_FROZEN0:
142 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
144 return tso_sizeW((StgTSO *)p);
146 return bco_sizeW((StgBCO *)p);
147 case TVAR_WAIT_QUEUE:
148 return sizeofW(StgTVarWaitQueue);
150 return sizeofW(StgTVar);
152 return sizeofW(StgTRecChunk);
154 return sizeofW(StgTRecHeader);
156 return sizeW_fromITBL(info);
161 thread_static( StgClosure* p )
163 const StgInfoTable *info;
165 // keep going until we've threaded all the objects on the linked
167 while (p != END_OF_STATIC_LIST) {
170 switch (info->type) {
173 thread((StgPtr)&((StgInd *)p)->indirectee);
174 p = IND_STATIC_LINK(p);
178 p = THUNK_STATIC_LINK(p);
181 p = FUN_STATIC_LINK(p);
184 p = STATIC_LINK(info,p);
188 barf("thread_static: strange closure %d", (int)(info->type));
195 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
201 bitmap = large_bitmap->bitmap[b];
202 for (i = 0; i < size; ) {
203 if ((bitmap & 1) == 0) {
208 if (i % BITS_IN(W_) == 0) {
210 bitmap = large_bitmap->bitmap[b];
212 bitmap = bitmap >> 1;
218 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
225 switch (fun_info->f.fun_type) {
227 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
228 size = BITMAP_SIZE(fun_info->f.b.bitmap);
231 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
232 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
236 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
237 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
240 if ((bitmap & 1) == 0) {
244 bitmap = bitmap >> 1;
253 thread_stack(StgPtr p, StgPtr stack_end)
255 const StgRetInfoTable* info;
259 // highly similar to scavenge_stack, but we do pointer threading here.
261 while (p < stack_end) {
263 // *p must be the info pointer of an activation
264 // record. All activation records have 'bitmap' style layout
267 info = get_ret_itbl((StgClosure *)p);
269 switch (info->i.type) {
271 // Dynamic bitmap: the mask is stored on the stack
275 dyn = ((StgRetDyn *)p)->liveness;
277 // traverse the bitmap first
278 bitmap = RET_DYN_LIVENESS(dyn);
279 p = (P_)&((StgRetDyn *)p)->payload[0];
280 size = RET_DYN_BITMAP_SIZE;
282 if ((bitmap & 1) == 0) {
286 bitmap = bitmap >> 1;
290 // skip over the non-ptr words
291 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
293 // follow the ptr words
294 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
301 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
302 case CATCH_RETRY_FRAME:
303 case CATCH_STM_FRAME:
304 case ATOMICALLY_FRAME:
310 bitmap = BITMAP_BITS(info->i.layout.bitmap);
311 size = BITMAP_SIZE(info->i.layout.bitmap);
313 // NOTE: the payload starts immediately after the info-ptr, we
314 // don't have an StgHeader in the same sense as a heap closure.
316 if ((bitmap & 1) == 0) {
320 bitmap = bitmap >> 1;
333 size = BCO_BITMAP_SIZE(bco);
334 thread_large_bitmap(p, BCO_BITMAP(bco), size);
339 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
343 size = GET_LARGE_BITMAP(&info->i)->size;
344 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
350 StgRetFun *ret_fun = (StgRetFun *)p;
351 StgFunInfoTable *fun_info;
353 fun_info = itbl_to_fun_itbl(
354 get_threaded_info((StgPtr)ret_fun->fun));
355 // *before* threading it!
356 thread((StgPtr)&ret_fun->fun);
357 p = thread_arg_block(fun_info, ret_fun->payload);
362 barf("thread_stack: weird activation record found on stack: %d",
363 (int)(info->i.type));
369 thread_PAP (StgPAP *pap)
372 StgWord bitmap, size;
373 StgFunInfoTable *fun_info;
375 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
376 ASSERT(fun_info->i.type != PAP);
378 p = (StgPtr)pap->payload;
381 switch (fun_info->f.fun_type) {
383 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
386 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
390 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
394 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
398 if ((bitmap & 1) == 0) {
402 bitmap = bitmap >> 1;
408 thread((StgPtr)&pap->fun);
413 thread_AP_STACK (StgAP_STACK *ap)
415 thread((StgPtr)&ap->fun);
416 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
417 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
421 thread_TSO (StgTSO *tso)
423 thread((StgPtr)&tso->link);
424 thread((StgPtr)&tso->global_link);
426 if ( tso->why_blocked == BlockedOnMVar
427 || tso->why_blocked == BlockedOnBlackHole
428 || tso->why_blocked == BlockedOnException
430 || tso->why_blocked == BlockedOnGA
431 || tso->why_blocked == BlockedOnGA_NoSend
434 thread((StgPtr)&tso->block_info.closure);
436 if ( tso->blocked_exceptions != NULL ) {
437 thread((StgPtr)&tso->blocked_exceptions);
440 thread((StgPtr)&tso->trec);
442 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
443 return (StgPtr)tso + tso_sizeW(tso);
448 update_fwd_large( bdescr *bd )
451 const StgInfoTable* info;
453 for (; bd != NULL; bd = bd->link) {
456 info = get_itbl((StgClosure *)p);
458 switch (info->type) {
465 case MUT_ARR_PTRS_FROZEN:
466 case MUT_ARR_PTRS_FROZEN0:
471 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
472 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
479 thread_TSO((StgTSO *)p);
483 thread_AP_STACK((StgAP_STACK *)p);
487 thread_PAP((StgPAP *)p);
491 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
497 thread_obj (StgInfoTable *info, StgPtr p)
499 switch (info->type) {
503 return p + sizeofW(StgHeader) + 1;
507 thread((StgPtr)&((StgClosure *)p)->payload[0]);
508 return p + sizeofW(StgHeader) + 1;
511 thread((StgPtr)&((StgClosure *)p)->payload[0]);
512 return p + sizeofW(StgHeader) + 1;
517 return p + sizeofW(StgHeader) + 2;
522 thread((StgPtr)&((StgClosure *)p)->payload[0]);
523 return p + sizeofW(StgHeader) + 2;
528 thread((StgPtr)&((StgClosure *)p)->payload[0]);
529 thread((StgPtr)&((StgClosure *)p)->payload[1]);
530 return p + sizeofW(StgHeader) + 2;
533 StgBCO *bco = (StgBCO *)p;
534 thread((StgPtr)&bco->instrs);
535 thread((StgPtr)&bco->literals);
536 thread((StgPtr)&bco->ptrs);
537 thread((StgPtr)&bco->itbls);
538 return p + bco_sizeW(bco);
549 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);
845 if (info->type == TSO) {
846 move_TSO((StgTSO *)p, (StgTSO *)free);
857 // free the remaining blocks and count what's left.
858 free_bd->free = free;
859 if (free_bd->link != NULL) {
860 freeChain(free_bd->link);
861 free_bd->link = NULL;
863 stp->n_blocks = free_blocks;
869 compact( void (*get_roots)(evac_fn) )
874 // 1. thread the roots
875 get_roots((evac_fn)thread);
877 // the weak pointer lists...
878 if (weak_ptr_list != NULL) {
879 thread((StgPtr)&weak_ptr_list);
881 if (old_weak_ptr_list != NULL) {
882 thread((StgPtr)&old_weak_ptr_list); // tmp
886 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
889 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
890 for (p = bd->start; p < bd->free; p++) {
896 // the global thread list
897 thread((StgPtr)&all_threads);
899 // any threads resurrected during this GC
900 thread((StgPtr)&resurrected_threads);
902 // the main threads list
905 for (m = main_threads; m != NULL; m = m->link) {
906 thread((StgPtr)&m->tso);
910 // the static objects
911 thread_static(scavenged_static_objects);
913 // the stable pointer table
914 threadStablePtrTable((evac_fn)thread);
916 // the CAF list (used by GHCi)
917 markCAFs((evac_fn)thread);
919 // 2. update forward ptrs
920 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
921 for (s = 0; s < generations[g].n_steps; s++) {
922 stp = &generations[g].steps[s];
923 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
925 update_fwd(stp->to_blocks);
926 update_fwd_large(stp->scavenged_large_objects);
927 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
928 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
929 update_fwd_compact(stp->blocks);
934 // 3. update backward ptrs
935 stp = &oldest_gen->steps[0];
936 if (stp->blocks != NULL) {
937 blocks = update_bkwd_compact(stp);
938 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
939 stp->gen->no, stp->no,
940 stp->n_blocks, blocks););
941 stp->n_blocks = blocks;