X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=cfa23c11a8c3ac732e6504a9d3ee55b03a1e3129;hb=f8e722a44f00e5d388aad1a613f62361058dda0d;hp=0b236bfc9f157054617172649e88032ddd4e30ee;hpb=f762be1b5a12b215595acdfb0343a6161e1a0e86;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 0b236bf..cfa23c1 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.132 2002/03/12 11:50:02 simonmar Exp $ + * $Id: GC.c,v 1.140 2002/09/06 09:56:12 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -45,6 +45,8 @@ #include "RetainerProfile.h" #include "LdvProfile.h" +#include + /* STATIC OBJECT LIST. * * During GC: @@ -79,8 +81,8 @@ * We build up a static object list while collecting generations 0..N, * which is then appended to the static object list of generation N+1. */ -StgClosure* static_objects; // live static objects -StgClosure* scavenged_static_objects; // static objects scavenged so far +static StgClosure* static_objects; // live static objects +StgClosure* scavenged_static_objects; // static objects scavenged so far /* N is the oldest generation being collected, where the generations * are numbered starting at 0. A major GC (indicated by the major_gc @@ -118,16 +120,16 @@ static rtsBool failed_to_evac; /* Old to-space (used for two-space collector only) */ -bdescr *old_to_blocks; +static bdescr *old_to_blocks; /* Data used for allocation area sizing. */ -lnat new_blocks; // blocks allocated during this GC -lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC +static lnat new_blocks; // blocks allocated during this GC +static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC /* Used to avoid long recursion due to selector thunks */ -lnat thunk_selector_depth = 0; +static lnat thunk_selector_depth = 0; #define MAX_THUNK_SELECTOR_DEPTH 256 /* ----------------------------------------------------------------------------- @@ -142,6 +144,8 @@ static void zero_mutable_list ( StgMutClosure *first ); static rtsBool traverse_weak_ptr_list ( void ); static void mark_weak_ptr_list ( StgWeak **list ); +static StgClosure * eval_thunk_selector ( nat field, StgSelector * p ); + static void scavenge ( step * ); static void scavenge_mark_stack ( void ); static void scavenge_stack ( StgPtr p, StgPtr stack_end ); @@ -985,7 +989,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // Reset the nursery resetNurseries(); - // let go of lock (so that it can be re-grabbed below). RELEASE_LOCK(&sched_mutex); // start any pending finalizers @@ -993,7 +996,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // send exceptions to any threads which were about to die resurrectThreads(resurrected_threads); - + ACQUIRE_LOCK(&sched_mutex); // Update the stable pointer hash table. @@ -1105,31 +1108,41 @@ traverse_weak_ptr_list(void) continue; } - ASSERT(get_itbl(w)->type == WEAK); - - /* Now, check whether the key is reachable. - */ - new = isAlive(w->key); - if (new != NULL) { - w->key = new; - // evacuate the value and finalizer - w->value = evacuate(w->value); - w->finalizer = evacuate(w->finalizer); - // remove this weak ptr from the old_weak_ptr list - *last_w = w->link; - // and put it on the new weak ptr list - next_w = w->link; - w->link = weak_ptr_list; - weak_ptr_list = w; - flag = rtsTrue; - IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", - w, w->key)); - continue; - } - else { - last_w = &(w->link); - next_w = w->link; + switch (get_itbl(w)->type) { + + case EVACUATED: + next_w = (StgWeak *)((StgEvacuated *)w)->evacuee; + *last_w = next_w; continue; + + case WEAK: + /* Now, check whether the key is reachable. + */ + new = isAlive(w->key); + if (new != NULL) { + w->key = new; + // evacuate the value and finalizer + w->value = evacuate(w->value); + w->finalizer = evacuate(w->finalizer); + // remove this weak ptr from the old_weak_ptr list + *last_w = w->link; + // and put it on the new weak ptr list + next_w = w->link; + w->link = weak_ptr_list; + weak_ptr_list = w; + flag = rtsTrue; + IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", + w, w->key)); + continue; + } + else { + last_w = &(w->link); + next_w = w->link; + continue; + } + + default: + barf("traverse_weak_ptr_list: not WEAK"); } } @@ -1242,6 +1255,9 @@ mark_weak_ptr_list ( StgWeak **list ) last_w = list; for (w = *list; w; w = w->link) { + // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here + ASSERT(w->header.info == &stg_DEAD_WEAK_info + || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED); (StgClosure *)w = evacuate((StgClosure *)w); *last_w = w; last_w = &(w->link); @@ -1274,6 +1290,7 @@ isAlive(StgClosure *p) loop: bd = Bdescr((P_)p); + // ignore closures in generations that we're not collecting. if (LOOKS_LIKE_STATIC(p) || bd->gen_no > N) { return p; @@ -1454,8 +1471,8 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) Evacuate a large object This just consists of removing the object from the (doubly-linked) - large_alloc_list, and linking it on to the (singly-linked) - new_large_objects list, from where it will be scavenged later. + step->large_objects list, and linking it on to the (singly-linked) + step->new_large_objects list, from where it will be scavenged later. Convention: bd->flags has BF_EVACUATED set for a large object that has been evacuated, or unset otherwise. @@ -1584,9 +1601,6 @@ loop: if (HEAP_ALLOCED(q)) { bd = Bdescr((P_)q); - // not a group head: find the group head - if (bd->blocks == 0) { bd = bd->link; } - if (bd->gen_no > N) { /* Can't evacuate this object, because it's in a generation * older than the ones we're collecting. Let's hope that it's @@ -1712,143 +1726,26 @@ loop: case THUNK_SELECTOR: { - const StgInfoTable* selectee_info; - StgClosure* selectee = ((StgSelector*)q)->selectee; - - selector_loop: - selectee_info = get_itbl(selectee); - switch (selectee_info->type) { - case CONSTR: - case CONSTR_1_0: - case CONSTR_0_1: - case CONSTR_2_0: - case CONSTR_1_1: - case CONSTR_0_2: - case CONSTR_STATIC: - case CONSTR_NOCAF_STATIC: - { - StgWord offset = info->layout.selector_offset; - - // check that the size is in range - ASSERT(offset < - (StgWord32)(selectee_info->layout.payload.ptrs + - selectee_info->layout.payload.nptrs)); - - // perform the selection! - q = selectee->payload[offset]; - if (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();} - - /* if we're already in to-space, there's no need to continue - * with the evacuation, just update the source address with - * a pointer to the (evacuated) constructor field. - */ - if (HEAP_ALLOCED(q)) { - bdescr *bd = Bdescr((P_)q); - if (bd->flags & BF_EVACUATED) { - if (bd->gen_no < evac_gen) { - failed_to_evac = rtsTrue; - TICK_GC_FAILED_PROMOTION(); - } - return q; - } - } + StgClosure *p; - /* otherwise, carry on and evacuate this constructor field, - * (but not the constructor itself) - */ - goto loop; + if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) { + return copy(q,THUNK_SELECTOR_sizeW(),stp); } - case IND: - case IND_STATIC: - case IND_PERM: - case IND_OLDGEN: - case IND_OLDGEN_PERM: - selectee = ((StgInd *)selectee)->indirectee; - goto selector_loop; - - case EVACUATED: - selectee = ((StgEvacuated *)selectee)->evacuee; - goto selector_loop; - - case THUNK_SELECTOR: -# if 0 - /* Disabled 03 April 2001 by JRS; it seems to cause the GC (or - something) to go into an infinite loop when the nightly - stage2 compiles PrelTup.lhs. */ - - /* we can't recurse indefinitely in evacuate(), so set a - * limit on the number of times we can go around this - * loop. - */ - if (thunk_selector_depth < MAX_THUNK_SELECTOR_DEPTH) { - bdescr *bd; - bd = Bdescr((P_)selectee); - if (!bd->flags & BF_EVACUATED) { - thunk_selector_depth++; - selectee = evacuate(selectee); - thunk_selector_depth--; - goto selector_loop; - } - } else { - TICK_GC_SEL_ABANDONED(); - // and fall through... - } -# endif - - case AP_UPD: - case THUNK: - case THUNK_1_0: - case THUNK_0_1: - case THUNK_2_0: - case THUNK_1_1: - case THUNK_0_2: - case THUNK_STATIC: - case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: - case BLACKHOLE: - case BLACKHOLE_BQ: - // not evaluated yet - break; - -#if defined(PAR) - // a copy of the top-level cases below - case RBH: // cf. BLACKHOLE_BQ - { - //StgInfoTable *rip = get_closure_info(q, &size, &ptrs, &nonptrs, &vhs, str); - to = copy(q,BLACKHOLE_sizeW(),stp); - //ToDo: derive size etc from reverted IP - //to = copy(q,size,stp); - // recordMutable((StgMutClosure *)to); - return to; - } - - case BLOCKED_FETCH: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); - to = copy(q,sizeofW(StgBlockedFetch),stp); - return to; - -# ifdef DIST - case REMOTE_REF: -# endif - case FETCH_ME: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); - to = copy(q,sizeofW(StgFetchMe),stp); - return to; - - case FETCH_ME_BQ: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); - to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); - return to; -#endif + p = eval_thunk_selector(info->layout.selector_offset, + (StgSelector *)q); - default: - barf("evacuate: THUNK_SELECTOR: strange selectee %d", - (int)(selectee_info->type)); - } + if (p == NULL) { + return copy(q,THUNK_SELECTOR_sizeW(),stp); + } else { + // q is still BLACKHOLE'd. + thunk_selector_depth++; + p = evacuate(p); + thunk_selector_depth--; + upd_evacuee(q,p); + return p; + } } - return copy(q,THUNK_SELECTOR_sizeW(),stp); case IND: case IND_OLDGEN: @@ -1930,7 +1827,7 @@ loop: */ if (evac_gen > 0) { // optimisation StgClosure *p = ((StgEvacuated*)q)->evacuee; - if (Bdescr((P_)p)->gen_no < evac_gen) { + if (HEAP_ALLOCED(p) && Bdescr((P_)p)->gen_no < evac_gen) { failed_to_evac = rtsTrue; TICK_GC_FAILED_PROMOTION(); } @@ -2016,6 +1913,128 @@ loop: } /* ----------------------------------------------------------------------------- + Evaluate a THUNK_SELECTOR if possible. + + returns: NULL if we couldn't evaluate this THUNK_SELECTOR, or + a closure pointer if we evaluated it and this is the result + + If the return value is non-NULL, the original selector thunk has + been BLACKHOLE'd, and should be updated with an indirection or a + forwarding pointer. If the return value is NULL, then the selector + thunk is unchanged. + -------------------------------------------------------------------------- */ + +static StgClosure * +eval_thunk_selector( nat field, StgSelector * p ) +{ + StgInfoTable *info; + const StgInfoTable *info_ptr; + StgClosure *selectee; + + selectee = p->selectee; + + // Save the real info pointer (NOTE: not the same as get_itbl()). + info_ptr = p->header.info; + + // BLACKHOLE the selector thunk, since it is now under evaluation. + // This is important to stop us going into an infinite loop if + // this selector thunk eventually refers to itself. + SET_INFO(p,&stg_BLACKHOLE_info); + +selector_loop: + info = get_itbl(selectee); + switch (info->type) { + case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_2_0: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_STATIC: + case CONSTR_NOCAF_STATIC: + // check that the size is in range + ASSERT(field < (StgWord32)(info->layout.payload.ptrs + + info->layout.payload.nptrs)); + + return selectee->payload[field]; + + case IND: + case IND_STATIC: + case IND_PERM: + case IND_OLDGEN: + case IND_OLDGEN_PERM: + selectee = ((StgInd *)selectee)->indirectee; + goto selector_loop; + + case EVACUATED: + // We don't follow pointers into to-space; the constructor + // has already been evacuated, so we won't save any space + // leaks by evaluating this selector thunk anyhow. + break; + + case THUNK_SELECTOR: + { + StgClosure *val; + + // check that we don't recurse too much, re-using the + // depth bound also used in evacuate(). + thunk_selector_depth++; + if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) { + break; + } + + val = eval_thunk_selector(info->layout.selector_offset, + (StgSelector *)selectee); + + thunk_selector_depth--; + + if (val == NULL) { + break; + } else { + // we evaluated this selector thunk, so update it with + // an indirection. + UPD_IND_NOLOCK(selectee, val); + selectee = val; + goto selector_loop; + } + } + + case AP_UPD: + case THUNK: + case THUNK_1_0: + case THUNK_0_1: + case THUNK_2_0: + case THUNK_1_1: + case THUNK_0_2: + case THUNK_STATIC: + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + case BLACKHOLE_BQ: +#if defined(PAR) + case RBH: + case BLOCKED_FETCH: +# ifdef DIST + case REMOTE_REF: +# endif + case FETCH_ME: + case FETCH_ME_BQ: +#endif + // not evaluated yet + break; + + default: + barf("eval_thunk_selector: strange selectee %d", + (int)(info->type)); + } + + // We didn't manage to evaluate this thunk; restore the old info pointer + SET_INFO(p, info_ptr); + return NULL; +} + +/* ----------------------------------------------------------------------------- move_TSO is called to update the TSO structure after it has been moved from one place to another. -------------------------------------------------------------------------- */ @@ -2187,6 +2206,8 @@ scavenge(step *stp) info = get_itbl((StgClosure *)p); ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) || IS_HUGS_CONSTR_INFO(info))); + ASSERT(thunk_selector_depth == 0); + q = p; switch (info->type) {