/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.133 2002/04/13 05:16:25 sof Exp $
+ * $Id: GC.c,v 1.139 2002/09/05 16:26:33 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
#include "RetainerProfile.h"
#include "LdvProfile.h"
+#include <string.h>
+
/* STATIC OBJECT LIST.
*
* During GC:
* 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
/* 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
/* -----------------------------------------------------------------------------
// start any pending finalizers
scheduleFinalizers(old_weak_ptr_list);
- ACQUIRE_LOCK(&sched_mutex);
-
// send exceptions to any threads which were about to die
resurrectThreads(resurrected_threads);
+ ACQUIRE_LOCK(&sched_mutex);
+
// Update the stable pointer hash table.
updateStablePtrTable(major_gc);
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");
}
}
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);
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;
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.
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
const StgInfoTable* selectee_info;
StgClosure* selectee = ((StgSelector*)q)->selectee;
+ // We only recurse a certain depth through selector thunks.
+ // NOTE: the depth is maintained manually, and we must be very
+ // careful to always decrement it before returning.
+ //
+ thunk_selector_depth++;
+ if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) {
+ goto selector_abandon;
+ }
+
selector_loop:
selectee_info = get_itbl(selectee);
switch (selectee_info->type) {
(StgWord32)(selectee_info->layout.payload.ptrs +
selectee_info->layout.payload.nptrs));
+ // The thunk is now under evaluation, so we overwrite it
+ // with a BLACKHOLE. This has a beneficial effect if the
+ // selector thunk eventually refers to itself: we won't
+ // recurse indefinitely, and the object which eventually
+ // gets evacuated will be a BLACKHOLE (as it should be: a
+ // selector thunk which refers to itself can only have value
+ // _|_).
+ SET_INFO(q,&stg_BLACKHOLE_info);
+
// perform the selection!
- q = selectee->payload[offset];
+ selectee = 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;
- }
- }
-
- /* otherwise, carry on and evacuate this constructor field,
- * (but not the constructor itself)
- */
- goto loop;
+ // Carry on and evacuate this constructor field,
+ // (but not the constructor itself)
+ //
+ // It is tempting to just 'goto loop;' at this point, but
+ // that doesn't give us a way to decrement
+ // thunk_selector_depth later. So we recurse (boundedly)
+ // into evacuate().
+ //
+ selectee = evacuate(selectee);
+ upd_evacuee(q,selectee);
+ thunk_selector_depth--;
+ return selectee;
}
case IND:
goto selector_loop;
case EVACUATED:
- selectee = ((StgEvacuated *)selectee)->evacuee;
- goto selector_loop;
+ // We could follow forwarding pointers here too, but we don't
+ // for two reasons:
+ // * If the constructor has already been evacuated, then
+ // we're only doing the evaluation early, not fixing a
+ // space leak.
+ // * When we finally reach the destination, we have to
+ // figure out whether we are in to-space or not, and this
+ // is somewhat awkward.
+ //
+ // selectee = ((StgEvacuated *)selectee)->evacuee;
+ // goto selector_loop;
+ break;
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
-
+ q = evacuate(selectee);
+ thunk_selector_depth--;
+ return q;
+
case AP_UPD:
case THUNK:
case THUNK_1_0:
case SE_BLACKHOLE:
case BLACKHOLE:
case BLACKHOLE_BQ:
- // not evaluated yet
- break;
+ // not evaluated yet
+ break;
#if defined(PAR)
// a copy of the top-level cases below
//ToDo: derive size etc from reverted IP
//to = copy(q,size,stp);
// recordMutable((StgMutClosure *)to);
+ thunk_selector_depth--;
return to;
}
case BLOCKED_FETCH:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE);
to = copy(q,sizeofW(StgBlockedFetch),stp);
+ thunk_selector_depth--;
return to;
# ifdef DIST
case FETCH_ME:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp);
+ thunk_selector_depth--;
return to;
case FETCH_ME_BQ:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
+ thunk_selector_depth--;
return to;
#endif
(int)(selectee_info->type));
}
}
+ selector_abandon:
+ thunk_selector_depth--;
return copy(q,THUNK_SELECTOR_sizeW(),stp);
case IND:
*/
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();
}
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) {
projects / ghc-hetmet.git / blobdiff