/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.95 2001/02/08 18:04:49 sewardj Exp $
+ * $Id: GC.c,v 1.102 2001/04/03 16:35:12 sewardj 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;
}
}
-#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
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;
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);
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:
{
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);
projects / ghc-hetmet.git / blobdiff