/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.70 2000/01/14 13:17:15 hwloidl Exp $
+ * $Id: GC.c,v 1.75 2000/03/23 14:30:13 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
#include "SchedAPI.h"
#include "Weak.h"
#include "StablePriv.h"
+#include "Prelude.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
# include "ParallelRts.h"
*/
static nat evac_gen;
-/* WEAK POINTERS
+/* Weak pointers
*/
static StgWeak *old_weak_ptr_list; /* also pending finaliser list */
static rtsBool weak_done; /* all done for this pass */
+/* List of all threads during GC
+ */
+static StgTSO *old_all_threads;
+static StgTSO *resurrected_threads;
+
/* Flag indicating failure to evacuate an object to the desired
* generation.
*/
*/
bdescr *old_to_space;
+
/* Data used for allocation area sizing.
*/
lnat new_blocks; /* blocks allocated during this GC */
weak_ptr_list = NULL;
weak_done = rtsFalse;
+ /* The all_threads list is like the weak_ptr_list.
+ * See traverse_weak_ptr_list() for the details.
+ */
+ old_all_threads = all_threads;
+ all_threads = END_TSO_QUEUE;
+ resurrected_threads = END_TSO_QUEUE;
+
/* Mark the stable pointer table.
*/
markStablePtrTable(major_gc);
/* start any pending finalizers */
scheduleFinalizers(old_weak_ptr_list);
+ /* send exceptions to any threads which were about to die */
+ resurrectThreads(resurrected_threads);
+
/* check sanity after GC */
IF_DEBUG(sanity, checkSanity(N));
continue;
}
}
-
+
+ /* Now deal with the all_threads list, which behaves somewhat like
+ * the weak ptr list. If we discover any threads that are about to
+ * become garbage, we wake them up and administer an exception.
+ */
+ {
+ StgTSO *t, *tmp, *next, **prev;
+
+ prev = &old_all_threads;
+ for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+
+ /* Threads which have finished or died get dropped from
+ * the list.
+ */
+ switch (t->what_next) {
+ case ThreadKilled:
+ case ThreadComplete:
+ next = t->global_link;
+ *prev = next;
+ continue;
+ default:
+ }
+
+ /* Threads which have already been determined to be alive are
+ * moved onto the all_threads list.
+ */
+ (StgClosure *)tmp = isAlive((StgClosure *)t);
+ if (tmp != NULL) {
+ next = tmp->global_link;
+ tmp->global_link = all_threads;
+ all_threads = tmp;
+ *prev = next;
+ } else {
+ prev = &(t->global_link);
+ next = t->global_link;
+ }
+ }
+ }
+
/* If we didn't make any changes, then we can go round and kill all
* the dead weak pointers. The old_weak_ptr list is used as a list
* of pending finalizers later on.
for (w = old_weak_ptr_list; w; w = w->link) {
w->finalizer = evacuate(w->finalizer);
}
+
+ /* And resurrect any threads which were about to become garbage.
+ */
+ {
+ StgTSO *t, *tmp, *next;
+ for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+ next = t->global_link;
+ (StgClosure *)tmp = evacuate((StgClosure *)t);
+ tmp->global_link = resurrected_threads;
+ resurrected_threads = tmp;
+ }
+ }
+
weak_done = rtsTrue;
}
isAlive(StgClosure *p)
{
const StgInfoTable *info;
+ nat size;
while (1) {
/* alive! */
return ((StgEvacuated *)p)->evacuee;
+ case BCO:
+ size = bco_sizeW((StgBCO*)p);
+ goto large;
+
+ case ARR_WORDS:
+ size = arr_words_sizeW((StgArrWords *)p);
+ goto large;
+
+ case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_FROZEN:
+ size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+ goto large;
+
+ case TSO:
+ if (((StgTSO *)p)->what_next == ThreadRelocated) {
+ p = (StgClosure *)((StgTSO *)p)->link;
+ continue;
+ }
+
+ size = tso_sizeW((StgTSO *)p);
+ large:
+ if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)
+ && Bdescr((P_)p)->evacuated)
+ return p;
+ else
+ return NULL;
+
default:
/* dead. */
return NULL;
StgClosure *
MarkRoot(StgClosure *root)
{
- //if (root != END_TSO_QUEUE)
return evacuate(root);
}
case IND_PERM:
case IND_OLDGEN:
case IND_OLDGEN_PERM:
- selectee = stgCast(StgInd *,selectee)->indirectee;
+ selectee = ((StgInd *)selectee)->indirectee;
goto selector_loop;
case CAF_ENTERED:
- selectee = stgCast(StgCAF *,selectee)->value;
+ selectee = ((StgCAF *)selectee)->value;
goto selector_loop;
case EVACUATED:
- selectee = stgCast(StgEvacuated*,selectee)->evacuee;
+ selectee = ((StgEvacuated *)selectee)->evacuee;
goto selector_loop;
case THUNK:
case PAP:
/* these are special - the payload is a copy of a chunk of stack,
tagging and all. */
- return copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
+ return copy(q,pap_sizeW((StgPAP *)q),step);
case EVACUATED:
/* Already evacuated, just return the forwarding address.
case ARR_WORDS:
{
- nat size = arr_words_sizeW(stgCast(StgArrWords*,q));
+ nat size = arr_words_sizeW((StgArrWords *)q);
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
evacuate_large((P_)q, rtsFalse);
case MUT_ARR_PTRS:
case MUT_ARR_PTRS_FROZEN:
{
- nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q));
+ nat size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)q);
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
case TSO:
{
- StgTSO *tso = stgCast(StgTSO *,q);
+ StgTSO *tso = (StgTSO *)q;
nat size = tso_sizeW(tso);
int diff;
+ /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
+ */
+ if (tso->what_next == ThreadRelocated) {
+ q = (StgClosure *)tso->link;
+ goto loop;
+ }
+
/* Large TSOs don't get moved, so no relocation is required.
*/
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
* srt field in the info table. That's ok, because we'll
* never dereference it.
*/
- srt = stgCast(StgClosure **,info->srt);
+ srt = (StgClosure **)(info->srt);
srt_end = srt + info->srt_len;
for (; srt < srt_end; srt++) {
/* Special-case to handle references to closures hiding out in DLLs, since
closure that's fixed at link-time, and no extra magic is required.
*/
#ifdef ENABLE_WIN32_DLL_SUPPORT
- if ( stgCast(unsigned long,*srt) & 0x1 ) {
+ if ( (unsigned long)(*srt) & 0x1 ) {
evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
} else {
evacuate(*srt);
case BCO:
{
- StgBCO* bco = stgCast(StgBCO*,p);
+ StgBCO* bco = (StgBCO *)p;
nat i;
for (i = 0; i < bco->n_ptrs; i++) {
bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
* evacuate the function pointer too...
*/
{
- StgPAP* pap = stgCast(StgPAP*,p);
+ StgPAP* pap = (StgPAP *)p;
pap->fun = evacuate(pap->fun);
scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
case ARR_WORDS:
/* nothing to follow */
- p += arr_words_sizeW(stgCast(StgArrWords*,p));
+ p += arr_words_sizeW((StgArrWords *)p);
break;
case MUT_ARR_PTRS:
if (! LOOKS_LIKE_GHC_INFO(q) ) {
#ifdef DEBUG
if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) { /* Is it a static closure? */
- ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
+ ASSERT(closure_STATIC((StgClosure *)q));
}
/* otherwise, must be a pointer into the allocation space. */
#endif
case STOP_FRAME:
case CATCH_FRAME:
case SEQ_FRAME:
- {
- // StgPtr old_p = p; // debugging only -- HWL
- /* stack frames like these are ordinary closures and therefore may
- contain setup-specific fixed-header words (as in GranSim!);
- therefore, these cases should not use p++ but &(p->payload) -- HWL */
- // IF_DEBUG(gran, IF_DEBUG(sanity, printObj(p)));
- bitmap = info->layout.bitmap;
-
- p = (StgPtr)&(((StgClosure *)p)->payload);
- // IF_DEBUG(sanity, belch("HWL: scavenge_stack: (STOP|CATCH|SEQ)_FRAME adjusting p from %p to %p (instead of %p)", old_p, p, old_p+1));
- goto small_bitmap;
- }
case RET_BCO:
case RET_SMALL:
case RET_VEC_SMALL:
dbl_link_onto(bd, &step->scavenged_large_objects);
p = bd->start;
- info = get_itbl(stgCast(StgClosure*,p));
+ info = get_itbl((StgClosure *)p);
switch (info->type) {
case BCO:
{
- StgBCO* bco = stgCast(StgBCO*,p);
+ StgBCO* bco = (StgBCO *)p;
nat i;
evac_gen = saved_evac_gen;
for (i = 0; i < bco->n_ptrs; i++) {
enteredCAFs = caf->link;
ASSERT(get_itbl(caf)->type == CAF_ENTERED);
SET_INFO(caf,&CAF_UNENTERED_info);
- caf->value = stgCast(StgClosure*,0xdeadbeef);
- caf->link = stgCast(StgCAF*,0xdeadbeef);
+ caf->value = (StgClosure *)0xdeadbeef;
+ caf->link = (StgCAF *)0xdeadbeef;
}
enteredCAFs = END_CAF_LIST;
}
switch (get_itbl(update_frame)->type) {
case CATCH_FRAME:
- update_frame = stgCast(StgCatchFrame*,update_frame)->link;
+ update_frame = ((StgCatchFrame *)update_frame)->link;
break;
case UPDATE_FRAME:
break;
case SEQ_FRAME:
- update_frame = stgCast(StgSeqFrame*,update_frame)->link;
+ update_frame = ((StgSeqFrame *)update_frame)->link;
break;
case STOP_FRAME:
threadLazyBlackHole(tso);
}
+/* -----------------------------------------------------------------------------
+ * Debugging
+ * -------------------------------------------------------------------------- */
+
#if DEBUG
//@cindex printMutOnceList
void
printMutOnceList(generation *gen)
{
- StgMutClosure *p, *next, *new_list;
+ StgMutClosure *p, *next;
p = gen->mut_once_list;
- new_list = END_MUT_LIST;
next = p->mut_link;
- evac_gen = gen->no;
- failed_to_evac = rtsFalse;
-
fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list);
for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
fprintf(stderr, "%p (%s), ",
p = gen->saved_mut_list;
next = p->mut_link;
- evac_gen = 0;
- failed_to_evac = rtsFalse;
-
fprintf(stderr, "@@ Mutable list %p: ", gen->saved_mut_list);
for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
- fprintf(stderr, "%p (%s), ",
+ fprintf(stderr, "%p (%s), ",
p, info_type((StgClosure *)p));
}
fputc('\n', stderr);
projects / ghc-hetmet.git / blobdiff