/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.46 1999/03/03 17:22:11 simonm Exp $
+ * $Id: GC.c,v 1.50 1999/03/11 09:31:53 simonm Exp $
*
* (c) The GHC Team 1998-1999
*
static void revert_dead_CAFs ( void );
static rtsBool traverse_weak_ptr_list ( void );
-static void cleanup_weak_ptr_list ( void );
+static void cleanup_weak_ptr_list ( StgWeak **list );
static void scavenge_stack ( StgPtr p, StgPtr stack_end );
static void scavenge_large ( step *step );
for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
allocated -= BLOCK_SIZE_W;
}
+ if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
+ allocated -= (current_nursery->start + BLOCK_SIZE_W)
+ - current_nursery->free;
+ }
/* Figure out which generation to collect
*/
* the CAF document.
*/
extern void markHugsObjects(void);
-#if 0
- /* ToDo: This (undefined) function should contain the scavenge
- * loop immediately below this block of code - but I'm not sure
- * enough of the details to do this myself.
- */
- scavengeEverything();
- /* revert dead CAFs and update enteredCAFs list */
- revert_dead_CAFs();
-#endif
markHugsObjects();
-#if 0
- /* This will keep the CAFs and the attached BCOs alive
- * but the values will have been reverted
- */
- scavengeEverything();
-#endif
}
#endif
/* Final traversal of the weak pointer list (see comment by
* cleanUpWeakPtrList below).
*/
- cleanup_weak_ptr_list();
+ cleanup_weak_ptr_list(&weak_ptr_list);
/* Now see which stable names are still alive.
*/
gcStablePtrTable(major_gc);
+ /* revert dead CAFs and update enteredCAFs list */
+ revert_dead_CAFs();
+
/* Set the maximum blocks for the oldest generation, based on twice
* the amount of live data now, adjusted to fit the maximum heap
* size if necessary.
}
}
- /* revert dead CAFs and update enteredCAFs list */
- revert_dead_CAFs();
-
- /* mark the garbage collected CAFs as dead */
+ /* mark the garbage collected CAFs as dead */
#ifdef DEBUG
if (major_gc) { gcCAFs(); }
#endif
* of pending finalizers later on.
*/
if (flag == rtsFalse) {
+ cleanup_weak_ptr_list(&old_weak_ptr_list);
for (w = old_weak_ptr_list; w; w = w->link) {
- w->value = evacuate(w->value);
w->finalizer = evacuate(w->finalizer);
}
weak_done = rtsTrue;
-------------------------------------------------------------------------- */
static void
-cleanup_weak_ptr_list ( void )
+cleanup_weak_ptr_list ( StgWeak **list )
{
StgWeak *w, **last_w;
- last_w = &weak_ptr_list;
- for (w = weak_ptr_list; w; w = w->link) {
+ last_w = list;
+ for (w = *list; w; w = w->link) {
if (get_itbl(w)->type == EVACUATED) {
w = (StgWeak *)((StgEvacuated *)w)->evacuee;
const StgInfoTable *info;
loop:
- if (!LOOKS_LIKE_STATIC(q)) {
+ if (HEAP_ALLOCED(q)) {
bd = Bdescr((P_)q);
if (bd->gen->no > N) {
/* Can't evacuate this object, because it's in a generation
* with the evacuation, just update the source address with
* a pointer to the (evacuated) constructor field.
*/
- if (IS_USER_PTR(q)) {
+ if (HEAP_ALLOCED(q)) {
bdescr *bd = Bdescr((P_)q);
if (bd->evacuated) {
if (bd->gen->no < evac_gen) {
srt = stgCast(StgClosure **,info->srt);
srt_end = srt + info->srt_len;
for (; srt < srt_end; srt++) {
- evacuate(*srt);
+ /* Special-case to handle references to closures hiding out in DLLs, since
+ double indirections required to get at those. The code generator knows
+ which is which when generating the SRT, so it stores the (indirect)
+ reference to the DLL closure in the table by first adding one to it.
+ We check for this here, and undo the addition before evacuating it.
+
+ If the SRT entry hasn't got bit 0 set, the SRT entry points to a
+ closure that's fixed at link-time, and no extra magic is required.
+ */
+#ifdef HAVE_WIN32_DLL_SUPPORT
+ if ( stgCast(unsigned long,*srt) & 0x1 ) {
+ evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
+ } else {
+ evacuate(*srt);
+ }
+#else
+ evacuate(*srt);
+#endif
}
}
case IND_PERM:
case IND_OLDGEN_PERM:
case CAF_UNENTERED:
- case CAF_ENTERED:
{
StgPtr end;
break;
}
+ case CAF_ENTERED:
+ {
+ StgCAF *caf = (StgCAF *)p;
+
+ caf->body = evacuate(caf->body);
+ caf->value = evacuate(caf->value);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ recordOldToNewPtrs((StgMutClosure *)p);
+ }
+ p += sizeofW(StgCAF);
+ break;
+ }
+
case MUT_VAR:
/* ignore MUT_CONSs */
if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
case IND_PERM:
case IND_OLDGEN_PERM:
case CAF_UNENTERED:
- case CAF_ENTERED:
{
StgPtr q, end;
}
continue;
+ case CAF_ENTERED:
+ {
+ StgCAF *caf = (StgCAF *)p;
+ caf->body = evacuate(caf->body);
+ caf->value = evacuate(caf->value);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ p->mut_link = new_list;
+ new_list = p;
+ }
+ }
+ continue;
+
+ case CAF_UNENTERED:
+ {
+ StgCAF *caf = (StgCAF *)p;
+ caf->body = evacuate(caf->body);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ p->mut_link = new_list;
+ new_list = p;
+ }
+ }
+ continue;
+
default:
/* shouldn't have anything else on the mutables list */
barf("scavenge_mut_once_list: strange object?");
/* Is q a pointer to a closure?
*/
- if (! LOOKS_LIKE_GHC_INFO(q)) {
+ if (! LOOKS_LIKE_GHC_INFO(q)) {
#ifdef DEBUG
- if (LOOKS_LIKE_STATIC(q)) { /* Is it a static closure? */
+ if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) { /* Is it a static closure? */
ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
- }
- /* otherwise, must be a pointer into the allocation space.
- */
+ }
+ /* otherwise, must be a pointer into the allocation space. */
#endif
(StgClosure *)*p = evacuate((StgClosure *)q);
caf->value = stgCast(StgClosure*,0xdeadbeef);
caf->link = stgCast(StgCAF*,0xdeadbeef);
}
+ enteredCAFs = END_CAF_LIST;
}
void revert_dead_CAFs(void)
StgCAF* caf = enteredCAFs;
enteredCAFs = END_CAF_LIST;
while (caf != END_CAF_LIST) {
- StgCAF* next = caf->link;
-
- switch(GET_INFO(caf)->type) {
- case EVACUATED:
- {
- /* This object has been evacuated, it must be live. */
- StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee);
- new->link = enteredCAFs;
- enteredCAFs = new;
- break;
- }
- case CAF_ENTERED:
- {
- SET_INFO(caf,&CAF_UNENTERED_info);
- caf->value = stgCast(StgClosure*,0xdeadbeef);
- caf->link = stgCast(StgCAF*,0xdeadbeef);
- break;
- }
- default:
- barf("revert_dead_CAFs: enteredCAFs list corrupted");
- }
- caf = next;
+ StgCAF *next, *new;
+ next = caf->link;
+ new = (StgCAF*)isAlive((StgClosure*)caf);
+ if (new) {
+ new->link = enteredCAFs;
+ enteredCAFs = new;
+ } else {
+ ASSERT(0);
+ SET_INFO(caf,&CAF_UNENTERED_info);
+ caf->value = (StgClosure*)0xdeadbeef;
+ caf->link = (StgCAF*)0xdeadbeef;
+ }
+ caf = next;
}
}
projects / ghc-hetmet.git / blobdiff