/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.94 2001/01/31 11:03: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"
# include "ParallelDebug.h"
# endif
#endif
-#if defined(GHCI)
-# include "HsFFI.h"
-# include "Linker.h"
-#endif
+#include "HsFFI.h"
+#include "Linker.h"
#if defined(RTS_GTK_FRONTPANEL)
#include "FrontPanel.h"
#endif
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
static void gcCAFs ( void );
#endif
-#ifdef GHCI
void revertCAFs ( void );
void scavengeCAFs ( void );
-#endif
//@node Garbage Collect, Weak Pointers, Static function declarations
//@subsection Garbage Collect
/* 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 */
}
}
-#ifdef GHCI
scavengeCAFs();
-#endif
/* follow all the roots that the application knows about.
*/
/* 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
}
/* mark the garbage collected CAFs as dead */
-#if defined(DEBUG) && !defined(GHCI)
- if (major_gc) { gcCAFs(); } /* doesn't work w/ GHCI */
+#if 0 /* doesn't work at the moment */
+#if defined(DEBUG)
+ if (major_gc) { gcCAFs(); }
+#endif
#endif
/* zero the scavenged static object list */
/* 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));
return q;
case IND_STATIC:
-#ifdef GHCI
- /* a revertible CAF - it'll be on the CAF list, so don't do
- * anything with it here (we'll scavenge it later).
+ /* If q->saved_info != NULL, then it's a revertible CAF - it'll be
+ * on the CAF list, so don't do anything with it here (we'll
+ * scavenge it later).
*/
- if (((StgIndStatic *)q)->saved_info != NULL) {
- return q;
- }
-#endif
- if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) {
- IND_STATIC_LINK((StgClosure *)q) = static_objects;
- static_objects = (StgClosure *)q;
+ if (major_gc
+ && ((StgIndStatic *)q)->saved_info == NULL
+ && IND_STATIC_LINK((StgClosure *)q) == NULL) {
+ IND_STATIC_LINK((StgClosure *)q) = static_objects;
+ static_objects = (StgClosure *)q;
}
return q;
*/
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
case THUNK_STATIC:
case FUN_STATIC:
scavenge_srt(info);
- /* fall through */
+ break;
case CONSTR_STATIC:
{
} 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;
Reverting CAFs
-------------------------------------------------------------------------- */
-#ifdef GHCI
-
void
revertCAFs( void )
{
StgIndStatic *c;
- for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+ for (c = (StgIndStatic *)caf_list; c != NULL;
+ c = (StgIndStatic *)c->static_link)
+ {
c->header.info = c->saved_info;
c->saved_info = NULL;
/* could, but not necessary: c->static_link = NULL; */
StgIndStatic *c;
evac_gen = 0;
- for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+ for (c = (StgIndStatic *)caf_list; c != NULL;
+ c = (StgIndStatic *)c->static_link)
+ {
c->indirectee = evacuate(c->indirectee);
}
}
-#endif /* GHCI */
-
/* -----------------------------------------------------------------------------
Sanity code for CAF garbage collection.
/* wasn't there something about update squeezing and ticky to be
* sorted out? oh yes: we aren't counting each enter properly
* in this case. See the log somewhere. KSW 1999-04-21
+ *
+ * Check two things: that the two update frames don't point to
+ * the same object, and that the updatee_bypass isn't already an
+ * indirection. Both of these cases only happen when we're in a
+ * block hole-style loop (and there are multiple update frames
+ * on the stack pointing to the same closure), but they can both
+ * screw us up if we don't check.
*/
- UPD_IND_NOLOCK(updatee_bypass, updatee_keep); /* this wakes the threads up */
+ if (updatee_bypass != updatee_keep && !closure_IND(updatee_bypass)) {
+ /* this wakes the threads up */
+ UPD_IND_NOLOCK(updatee_bypass, updatee_keep);
+ }
sp = (P_)frame - 1; /* sp = stuff to slide */
displacement += sizeofW(StgUpdateFrame);
{
StgInfoTable *info = get_itbl(bh);
nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i;
- for (i = np; i < np + nw; i++) {
+ /* don't zero out slop for a THUNK_SELECTOR, because it's layout
+ * info is used for a different purpose, and it's exactly the
+ * same size as a BLACKHOLE in any case.
+ */
+ if (info->type != THUNK_SELECTOR) {
+ for (i = np; i < np + nw; i++) {
((StgClosure *)bh)->payload[i] = 0;
+ }
}
}
#endif
projects / ghc-hetmet.git / blobdiff