/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.99 2001/03/20 11:37:21 simonmar Exp $
+ * $Id: GC.c,v 1.103 2001/07/23 10:47:16 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
#include "Weak.h"
#include "StablePriv.h"
#include "Prelude.h"
+#include "ParTicky.h" // ToDo: move into Rts.h
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
# include "ParallelRts.h"
lnat new_blocks; /* blocks allocated during this GC */
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;
+#define MAX_THUNK_SELECTOR_DEPTH 256
+
//@node Static function declarations, Garbage Collect, STATIC OBJECT LIST
//@subsection Static function declarations
/* tell the stats department that we've started a GC */
stat_startGC();
+ /* Init stats and print par specific (timing) info */
+ PAR_TICKY_PAR_START();
+
/* attribute any costs to CCS_GC */
#ifdef PROFILING
prev_CCS = CCCS;
*/
bd = allocBlock();
stp = &generations[g].steps[s];
- ASSERT(stp->gen->no == g);
+ ASSERT(stp->gen_no == g);
ASSERT(stp->hp ? Bdescr(stp->hp)->step == stp : rtsTrue);
- bd->gen = &generations[g];
+ bd->gen_no = g;
bd->step = stp;
bd->link = NULL;
bd->evacuated = 1; /* it's a to-space block */
stp = &generations[g].steps[s];
if (stp->hp_bd == NULL) {
bd = allocBlock();
- bd->gen = &generations[g];
+ bd->gen_no = g;
bd->step = stp;
bd->link = NULL;
bd->evacuated = 0; /* *not* a to-space block */
/* Mark the entries in the GALA table of the parallel system */
markLocalGAs(major_gc);
+ /* Mark all entries on the list of pending fetches */
+ markPendingFetches(major_gc);
#endif
/* Mark the weak pointer list, and prepare to detect dead weak
/* ok, GC over: tell the stats department what happened. */
stat_endGC(allocated, collected, live, copied, N);
+
+ //PAR_TICKY_TP();
}
//@node Weak Pointers, Evacuation, Garbage Collect
*/
/* ignore closures in generations that we're not collecting. */
- if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen->no > N) {
+ if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen_no > N) {
return p;
}
static void addBlock(step *stp)
{
bdescr *bd = allocBlock();
- bd->gen = stp->gen;
+ bd->gen_no = stp->gen_no;
bd->step = stp;
- if (stp->gen->no <= N) {
+ if (stp->gen_no <= N) {
bd->evacuated = 1;
} else {
bd->evacuated = 0;
* evacuate to an older generation, adjust it here (see comment
* by evacuate()).
*/
- if (stp->gen->no < evac_gen) {
+ if (stp->gen_no < evac_gen) {
#ifdef NO_EAGER_PROMOTION
failed_to_evac = rtsTrue;
#else
P_ dest, to, from;
TICK_GC_WORDS_COPIED(size_to_copy);
- if (stp->gen->no < evac_gen) {
+ if (stp->gen_no < evac_gen) {
#ifdef NO_EAGER_PROMOTION
failed_to_evac = rtsTrue;
#else
/* Don't forget to set the failed_to_evac flag if we didn't get
* the desired destination (see comments in evacuate()).
*/
- if (bd->gen->no < evac_gen) {
+ if (bd->gen_no < evac_gen) {
failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION();
}
/* link it on to the evacuated large object list of the destination step
*/
stp = bd->step->to;
- if (stp->gen->no < evac_gen) {
+ if (stp->gen_no < evac_gen) {
#ifdef NO_EAGER_PROMOTION
failed_to_evac = rtsTrue;
#else
}
bd->step = stp;
- bd->gen = stp->gen;
+ bd->gen_no = stp->gen_no;
bd->link = stp->new_large_objects;
stp->new_large_objects = bd;
bd->evacuated = 1;
loop:
if (HEAP_ALLOCED(q)) {
bd = Bdescr((P_)q);
- if (bd->gen->no > N) {
+ 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
* in evac_gen or older, or we will have to make an IND_OLDGEN object.
*/
- if (bd->gen->no < evac_gen) {
+ if (bd->gen_no < evac_gen) {
/* nope */
failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION();
case THUNK_0_2:
case THUNK_2_0:
#ifdef NO_PROMOTE_THUNKS
- if (bd->gen->no == 0 &&
+ if (bd->gen_no == 0 &&
bd->step->no != 0 &&
- bd->step->no == bd->gen->n_steps-1) {
+ bd->step->no == generations[bd->gen_no].n_steps-1) {
stp = bd->step;
}
#endif
if (HEAP_ALLOCED(q)) {
bdescr *bd = Bdescr((P_)q);
if (bd->evacuated) {
- if (bd->gen->no < evac_gen) {
+ if (bd->gen_no < evac_gen) {
failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION();
}
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->evacuated) {
+ thunk_selector_depth++;
+ selectee = evacuate(selectee);
+ thunk_selector_depth--;
+ goto selector_loop;
+ }
+ }
+ /* otherwise, fall through... */
+# endif
+
case AP_UPD:
case THUNK:
case THUNK_1_0:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_STATIC:
- case THUNK_SELECTOR:
- /* aargh - do recursively???? */
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
/* 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
+
default:
barf("evacuate: THUNK_SELECTOR: strange selectee %d",
(int)(selectee_info->type));
*/
if (evac_gen > 0) { /* optimisation */
StgClosure *p = ((StgEvacuated*)q)->evacuee;
- if (Bdescr((P_)p)->gen->no < evac_gen) {
+ if (Bdescr((P_)p)->gen_no < evac_gen) {
IF_DEBUG(gc, belch("@@ evacuate: evac of EVACUATED node %p failed!", p));
failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION();
q, info_type(q), to, info_type(to)));
return to;
+# ifdef DIST
+ case REMOTE_REF:
+# endif
case FETCH_ME:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp);
}
case IND_PERM:
- if (stp->gen->no != 0) {
+ if (stp->gen_no != 0) {
SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
}
/* fall through */
break;
}
+#ifdef DIST
+ case REMOTE_REF:
+#endif
case FETCH_ME:
- IF_DEBUG(gc,
- belch("@@ scavenge: HWL claims nothing to do for %p (%s)",
- p, info_type((StgClosure *)p)));
p += sizeofW(StgFetchMe);
break; // nothing to do in this case
break;
}
+#ifdef DIST
+ case REMOTE_REF:
+ barf("scavenge_mutable_list: REMOTE_REF %d", (int)(info->type));
+#endif
case FETCH_ME:
p += sizeofW(StgFetchMe);
break; // nothing to do in this case
} else {
bdescr *bd = Bdescr((P_)frame->updatee);
step *stp;
- if (bd->gen->no > N) {
- if (bd->gen->no < evac_gen) {
+ if (bd->gen_no > N) {
+ if (bd->gen_no < evac_gen) {
failed_to_evac = rtsTrue;
}
continue;
/* Don't promote blackholes */
stp = bd->step;
- if (!(stp->gen->no == 0 &&
+ if (!(stp->gen_no == 0 &&
stp->no != 0 &&
stp->no == stp->gen->n_steps-1)) {
stp = stp->to;
projects / ghc-hetmet.git / blobdiff