Commit 8435b2e4 authored by simonmar's avatar simonmar

[project @ 2002-09-05 16:26:33 by simonmar]

Fix for infinite loop when there is a THUNK_SELECTOR which eventually
refers to itself, such as might be generated by code like

	let x = (fst x, snd x) in ...

At the same time, I re-enabled the code to traverse multiple selector
thunks with bounded depth, because I believe it now works.

MERGE TO STABLE (but test thoroughly in the HEAD first, this is
fragile stuff)
parent 5ac854ef
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.138 2002/08/16 13:29:06 simonmar Exp $ * $Id: GC.c,v 1.139 2002/09/05 16:26:33 simonmar Exp $
* *
* (c) The GHC Team 1998-1999 * (c) The GHC Team 1998-1999
* *
...@@ -1727,6 +1727,15 @@ loop: ...@@ -1727,6 +1727,15 @@ loop:
const StgInfoTable* selectee_info; const StgInfoTable* selectee_info;
StgClosure* selectee = ((StgSelector*)q)->selectee; 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: selector_loop:
selectee_info = get_itbl(selectee); selectee_info = get_itbl(selectee);
switch (selectee_info->type) { switch (selectee_info->type) {
...@@ -1746,29 +1755,30 @@ loop: ...@@ -1746,29 +1755,30 @@ loop:
(StgWord32)(selectee_info->layout.payload.ptrs + (StgWord32)(selectee_info->layout.payload.ptrs +
selectee_info->layout.payload.nptrs)); 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! // 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 (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();}
// Carry on and evacuate this constructor field,
/* if we're already in to-space, there's no need to continue // (but not the constructor itself)
* with the evacuation, just update the source address with //
* a pointer to the (evacuated) constructor field. // It is tempting to just 'goto loop;' at this point, but
*/ // that doesn't give us a way to decrement
if (HEAP_ALLOCED(q)) { // thunk_selector_depth later. So we recurse (boundedly)
bdescr *bd = Bdescr((P_)q); // into evacuate().
if (bd->flags & BF_EVACUATED) { //
if (bd->gen_no < evac_gen) { selectee = evacuate(selectee);
failed_to_evac = rtsTrue; upd_evacuee(q,selectee);
TICK_GC_FAILED_PROMOTION(); thunk_selector_depth--;
} return selectee;
return q;
}
}
/* otherwise, carry on and evacuate this constructor field,
* (but not the constructor itself)
*/
goto loop;
} }
case IND: case IND:
...@@ -1780,33 +1790,27 @@ loop: ...@@ -1780,33 +1790,27 @@ loop:
goto selector_loop; goto selector_loop;
case EVACUATED: case EVACUATED:
selectee = ((StgEvacuated *)selectee)->evacuee; // We could follow forwarding pointers here too, but we don't
goto selector_loop; // 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: 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 /* we can't recurse indefinitely in evacuate(), so set a
* limit on the number of times we can go around this * limit on the number of times we can go around this
* loop. * loop.
*/ */
if (thunk_selector_depth < MAX_THUNK_SELECTOR_DEPTH) { q = evacuate(selectee);
bdescr *bd;
bd = Bdescr((P_)selectee);
if (!bd->flags & BF_EVACUATED) {
thunk_selector_depth++;
selectee = evacuate(selectee);
thunk_selector_depth--; thunk_selector_depth--;
goto selector_loop; return q;
}
} else {
TICK_GC_SEL_ABANDONED();
// and fall through...
}
# endif
case AP_UPD: case AP_UPD:
case THUNK: case THUNK:
...@@ -1833,12 +1837,14 @@ loop: ...@@ -1833,12 +1837,14 @@ loop:
//ToDo: derive size etc from reverted IP //ToDo: derive size etc from reverted IP
//to = copy(q,size,stp); //to = copy(q,size,stp);
// recordMutable((StgMutClosure *)to); // recordMutable((StgMutClosure *)to);
thunk_selector_depth--;
return to; return to;
} }
case BLOCKED_FETCH: case BLOCKED_FETCH:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE);
to = copy(q,sizeofW(StgBlockedFetch),stp); to = copy(q,sizeofW(StgBlockedFetch),stp);
thunk_selector_depth--;
return to; return to;
# ifdef DIST # ifdef DIST
...@@ -1847,11 +1853,13 @@ loop: ...@@ -1847,11 +1853,13 @@ loop:
case FETCH_ME: case FETCH_ME:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp); to = copy(q,sizeofW(StgFetchMe),stp);
thunk_selector_depth--;
return to; return to;
case FETCH_ME_BQ: case FETCH_ME_BQ:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
thunk_selector_depth--;
return to; return to;
#endif #endif
...@@ -1860,6 +1868,8 @@ loop: ...@@ -1860,6 +1868,8 @@ loop:
(int)(selectee_info->type)); (int)(selectee_info->type));
} }
} }
selector_abandon:
thunk_selector_depth--;
return copy(q,THUNK_SELECTOR_sizeW(),stp); return copy(q,THUNK_SELECTOR_sizeW(),stp);
case IND: case IND:
...@@ -1942,7 +1952,7 @@ loop: ...@@ -1942,7 +1952,7 @@ loop:
*/ */
if (evac_gen > 0) { // optimisation if (evac_gen > 0) { // optimisation
StgClosure *p = ((StgEvacuated*)q)->evacuee; 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; failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION(); TICK_GC_FAILED_PROMOTION();
} }
...@@ -2199,6 +2209,8 @@ scavenge(step *stp) ...@@ -2199,6 +2209,8 @@ scavenge(step *stp)
info = get_itbl((StgClosure *)p); info = get_itbl((StgClosure *)p);
ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) || IS_HUGS_CONSTR_INFO(info))); ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) || IS_HUGS_CONSTR_INFO(info)));
ASSERT(thunk_selector_depth == 0);
q = p; q = p;
switch (info->type) { switch (info->type) {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment