*************************************************************************** GENERATIONAL GARBAGE COLLECTION Global heap requirements as for 1s and 2s collectors. ++ All closures in the old generation that are updated must be updated with indirections and placed on the linked list of updated old generation closures. Promotion collection: --------------------- Collects allocation area into 2nd semi-space and promotes new semi-space by collecting into old generation. evac < AllocGen ==> Collect to old generation (see _EvacuateP) Roots: Roots, Astk, Bstk, OldRoots, OldInNew, CAFlist, NewCAFlist OldRoots: Newly promoted closures may reference new semi-space. Discard OldInNew roots (promoted). This keeps recent new gen roots in new gen. Remember OldRoots in alloc (not promoted). When evacuating to new check if Scav in OldGen, if so allocate oldgen root ind and add to OldInNew. N.B. This includes evacuating a forward reference. Set special forward ref to this OldGen root closure. if oldgen evacs return oldgen root else return new gen. CAFlist: Remember NewCAFlist in OldCAFlist (promoted). Remember CAFlist in NewCAFlist (not promoted). *************************************************************************** \begin{code} #if defined(GCgn) #define SCAV_REG_MAP #include "SMinternal.h" REGDUMP(ScavRegDump); genData genInfo = {0, 0, 0, 0, 0, 0, /* Alloc */ 0, {{0, 0}, {0, 0}}, /* New Gen */ 0, 0, 0, 0, 0, 0, /* Old Gen */ 0, 0, 0, 0, 0, 0, 0, /* OldRoots & CAfs */ 0, {{0, 0}, {0, 0}} /* 2s */ }; P_ heap_space = 0; /* Address of first word of slab of memory allocated for heap */ P_ hp_start; /* Value of Hp when reduction was resumed */ /* Always allocbase - 1 */ I_ initHeap( sm ) smInfo *sm; { I_ heap_error = 0; I_ bit_words; /* should cause link error */ ADRpanic("Completely untested on SP and MP stuff... also doesn't benefit from commoning up in SMcopying and SMcompacting"); if (heap_space == 0) { /* allocates if it doesn't already exist */ /* Allocate the roots space */ sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); /* Allocate the heap */ heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); if (SM_force_gc == USE_2s) { stat_init("TWOSPACE(GEN)", " No of Roots Caf Caf Astk Bstk", "Astk Bstk Reg No bytes bytes bytes"); } else { stat_init("GEN", "Promote Old No of Roots Caf Mut- Old Old OldGen Collec Resid", " bytes roots Astk Bstk Reg No able Alc New bytes tion %heap"); } } if (SM_force_gc == USE_2s) { genInfo.semi_space = SM_word_heap_size / 2; genInfo.space[0].base = HEAP_FRAME_BASE(heap_space, genInfo.semi_space); genInfo.space[1].base = HEAP_FRAME_BASE(heap_space + genInfo.semi_space, genInfo.semi_space); genInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, genInfo.semi_space); genInfo.space[1].lim = HEAP_FRAME_LIMIT(heap_space + genInfo.semi_space, genInfo.semi_space); genInfo.semi_space = 0; genInfo.oldlim = heap_space - 1; /* Never in old generation */ sm->hp = hp_start = genInfo.space[genInfo.semi_space].base - 1; if (SM_alloc_size) { sm->hplim = sm->hp + SM_alloc_size; SM_alloc_min = 0; /* No min; alloc size specified */ if (sm->hplim > genInfo.space[genInfo.semi_space].lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); return -1; } } else { sm->hplim = genInfo.space[genInfo.semi_space].lim; } sm->OldLim = genInfo.oldlim; sm->CAFlist = NULL; #ifndef PAR initExtensions( sm ); #endif if (SM_trace) { fprintf(stderr, "GEN(2s) Heap: 0x%lx .. 0x%lx\n", (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size)); fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %ld\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, (W_) genInfo.space[genInfo.semi_space].lim, (W_) sm->hp, (W_) sm->hplim, (I_) (sm->hplim - sm->hp)); } return 0; } if (SM_alloc_size == 0) SM_alloc_size = DEFAULT_ALLOC_SIZE; genInfo.alloc_words = SM_alloc_size; genInfo.new_words = SM_alloc_size; genInfo.allocbase = heap_space + SM_word_heap_size - genInfo.alloc_words; genInfo.alloclim = heap_space + SM_word_heap_size - 1; genInfo.newgen[0].newbase = genInfo.allocbase - genInfo.new_words; genInfo.newgen[0].newlim = genInfo.newgen[0].newbase - 1; genInfo.newgen[1].newbase = genInfo.allocbase - 2 * genInfo.new_words; genInfo.newgen[1].newlim = genInfo.newgen[1].newbase - 1; genInfo.oldbase = heap_space; if (SM_major_gen_size) { genInfo.old_words = SM_major_gen_size; genInfo.oldend = heap_space + genInfo.old_words - 1; genInfo.oldthresh = genInfo.oldend - genInfo.new_words; /* ToDo: extra old ind words not accounted for ! */ bit_words = (genInfo.old_words + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); if (genInfo.alloc_words > bit_words * (sizeof(BitWord)/sizeof(W_))) { /* bit vector in allocation area */ genInfo.bit_vect = (BitWord *) genInfo.allocbase; if (genInfo.oldend >= genInfo.newgen[1].newbase) heap_error = 1; } else { /* bit area in free area */ genInfo.bit_vect = (BitWord *) genInfo.oldend + 1; if (genInfo.bit_vect + bit_words >= (BitWord *) genInfo.newgen[1].newbase) heap_error = 1; } } else { genInfo.old_words = SM_word_heap_size - genInfo.alloc_words - 2 * genInfo.new_words; genInfo.oldend = heap_space + genInfo.old_words - 1; genInfo.oldthresh = genInfo.oldend - genInfo.new_words; /* ToDo: extra old ind words not accounted for ! */ bit_words = (genInfo.old_words + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); if (genInfo.alloc_words > bit_words * (sizeof(BitWord)/sizeof(W_))) { /* bit vector in allocation area */ genInfo.bit_vect = (BitWord *) genInfo.allocbase; } else { /* bit vector in reserved space in old generation */ bit_words = (genInfo.old_words + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); genInfo.bit_vect = (BitWord *) heap_space; genInfo.oldbase += bit_words; genInfo.old_words -= bit_words; } if (genInfo.oldbase > genInfo.oldthresh) heap_error = 1; } if (heap_error) { fprintf(stderr, "initHeap: Requested heap size: %ld\n", SM_word_heap_size); fprintf(stderr, " Alloc area %ld Delay area %ld Old area %ld Bit area %ld\n", genInfo.alloc_words, genInfo.new_words * 2, genInfo.old_words, genInfo.bit_vect == (BitWord *) genInfo.allocbase ? 0 : bit_words); fprintf(stderr, " Heap not large enough for generational gc with these specs\n"); fprintf(stderr, " +RTS -H option will increase heap size and/or\n"); fprintf(stderr, " -A option will decrease allocation area\n"); return -1; } genInfo.oldlim = genInfo.oldbase - 1; genInfo.oldwas = genInfo.oldbase - 1; genInfo.curnew = 0; genInfo.OldInNew = 0; genInfo.OldInNewno = 0; genInfo.NewCAFlist = NULL; genInfo.NewCAFno = 0; genInfo.OldCAFlist = NULL; genInfo.OldCAFno = 0; genInfo.PromMutables = 0; sm->hp = hp_start = genInfo.allocbase - 1; sm->hplim = genInfo.alloclim; sm->OldLim = genInfo.oldlim; sm->CAFlist = NULL; #ifndef PAR initExtensions( sm ); #endif if (SM_trace) { fprintf(stderr, "GEN Heap: 0x%lx .. 0x%lx\n", (W_) heap_space, (W_) (heap_space + SM_word_heap_size - 1)); fprintf(stderr, " alloc %ld, new %ld, old %ld, bit %ld\n", genInfo.alloc_words, genInfo.new_words, genInfo.old_words, bit_words); fprintf(stderr, " allocbase 0x%lx, alloclim 0x%lx\n", (W_) genInfo.allocbase, (W_) genInfo.alloclim); fprintf(stderr, " newbases 0x%lx 0x%lx\n", (W_) genInfo.newgen[0].newbase, (W_) genInfo.newgen[1].newbase); fprintf(stderr, " oldbase 0x%lx oldthresh 0x%lx bits 0x%lx\n", (W_) genInfo.oldbase, (W_) genInfo.oldthresh, (W_) genInfo.bit_vect); fprintf(stderr, " hp 0x%lx, hplim 0x%lx\n", (W_) sm->hp, (W_) sm->hplim); } return 0; } I_ collect2s(reqsize, sm) W_ reqsize; smInfo *sm; { I_ root, bstk_roots, caf_roots, extra_caf_words; PP_ stackptr; P_ CAFptr, updateFramePtr, caf_start; I_ free_space, /* No of words of free space following GC */ alloc, /* Number of words allocated since last GC */ resident; /* Number of words remaining after GC */ SAVE_REGS(&ScavRegDump); /* Save registers */ if (SM_trace) fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, (W_) genInfo.space[genInfo.semi_space].lim, (W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_))); alloc = sm->hp - hp_start; stat_startGC(alloc); genInfo.semi_space = NEXT_SEMI_SPACE(genInfo.semi_space); ToHp = genInfo.space[genInfo.semi_space].base - 1; Scav = genInfo.space[genInfo.semi_space].base; OldGen = sm->OldLim; /* always evac ! */ DEBUG_STRING("Setting Evac & Upd CAFs:"); for (CAFptr = sm->CAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { INFO_PTR(CAFptr) = (W_) Caf_Evac_Upd_info; } #ifdef PAR EvacuateLocalGAs(rtsTrue); #else evacSPTable( sm ); #endif /* PAR */ DEBUG_STRING("Evacuate Roots:"); for (root = 0; root < sm->rootno; root++) { P_ evac = sm->roots[root]; sm->roots[root] = EVACUATE_CLOSURE(evac); } #if !defined(PAR) DEBUG_STRING("Evacuate A Stack:"); for (stackptr = MAIN_SpA; SUBTRACT_A_STK(stackptr, stackInfo.botA) >= 0; /* botA points to bottom-most word */ stackptr = stackptr + AREL(1)) { P_ evac = *stackptr; *stackptr = EVACUATE_CLOSURE(evac); } DEBUG_STRING("Evacuate B Stack:"); bstk_roots = 0; for (updateFramePtr = MAIN_SuB; /* SuB points to topmost update frame */ SUBTRACT_B_STK(updateFramePtr, stackInfo.botB) > 0; /* botB points to bottom-most word */ /* re-initialiser given explicitly */) { P_ evac = GRAB_UPDATEE(updateFramePtr); PUSH_UPDATEE(updateFramePtr, EVACUATE_CLOSURE(evac)); bstk_roots++; updateFramePtr = GRAB_SuB(updateFramePtr); } #endif /* PAR */ DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp); while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp); DEBUG_STRING("Evacuate & Scavenge CAFs:"); caf_roots = 0; caf_start = ToHp; for (CAFptr = sm->CAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */ caf_roots++; DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp); while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp); /* this_extra_caf_words = ToHp - this_caf_start; */ /* ToDo: Report individual CAF space */ } extra_caf_words = ToHp - caf_start; #ifdef PAR RebuildGAtables(rtsTrue); #else reportDeadMallocPtrs( sm->MallocPtrList, NULL, &(sm->MallocPtrList) ); #endif /* PAR */ /* TIDY UP AND RETURN */ sm->hp = hp_start = ToHp; /* Last allocated word */ sm->hplim = genInfo.space[genInfo.semi_space].lim; resident = sm->hp - (genInfo.space[genInfo.semi_space].base - 1); /* DONT_DO_MAX_RESIDENCY -- because this collector is utterly hosed */ free_space = sm->hplim - sm->hp; if (SM_stats_verbose) { char comment_str[BIG_STRING_LEN]; #ifndef PAR sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_), (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_)); #else /* ToDo: come up with some interesting statistics for the parallel world */ sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0); #endif stat_endGC(alloc, SM_word_heap_size, resident, comment_str); } else { stat_endGC(alloc, SM_word_heap_size, resident, ""); } if (SM_trace) fprintf(stderr, "Done: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, (W_) genInfo.space[genInfo.semi_space].lim, (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_))); #ifdef DEBUG /* To help flush out bugs, we trash the part of the heap from which we're about to start allocating. */ TrashMem(sm->hp+1, sm->hplim); #endif /* DEBUG */ RESTORE_REGS(&ScavRegDump); /* Restore Registers */ if ((SM_alloc_size > free_space) || (reqsize > free_space)) return(-1); /* Heap exhausted */ return(0); /* Heap OK */ } I_ collectHeap(reqsize, sm) W_ reqsize; smInfo *sm; { PP_ stackptr, botA; P_ mutptr, prevmut, updateFramePtr, botB, CAFptr, prevCAF, oldroot, oldstartToHp, oldstartOldHp, oldscav, newscav; I_ root, rootno, bstk_roots, mutable, alloc_cafs, new_cafs, alloc_oldroots, new_oldroots, old_words; I_ bit_words; P_ oldlim; PP_ CAFlocs, CAFloc; I_ alloc, /* number of words allocated since last GC */ collect, /* number of words collected */ promote, /* number of words promoted */ resident, /* number of words remaining */ total_resident; /* total number of words remaining after major collection */ fflush(stdout); /* Flush stdout at start of GC */ if (SM_force_gc == USE_2s) { return collect2s(reqsize, sm); } if (reqsize > genInfo.alloc_words) { fprintf(stderr, "collectHeap: Required size %ld greater then allocation area %ld!\n", reqsize, genInfo.alloc_words); fprintf(stderr, " Rerun using +RTS -A to increase allocation area\n"); EXIT(EXIT_FAILURE); } SAVE_REGS(&ScavRegDump); /* Save registers */ if (SM_trace) fprintf(stderr, "GEN Start: hp 0x%lx, hplim 0x%lx, req %ld Minor\n", (W_) sm->hp, (W_) sm->hplim, (I_) (reqsize * sizeof(W_))); alloc = sm->hp - hp_start; stat_startGC(alloc); /* MINOR COLLECTION WITH PROMOTION */ collect = alloc + (genInfo.newgen[genInfo.curnew].newlim - genInfo.newgen[genInfo.curnew].newbase + 1); genInfo.curnew = (genInfo.curnew + 1) % 2; ToHp = genInfo.newgen[genInfo.curnew].newbase - 1; OldGen = genInfo.oldend; /* <= OldGen indicates in the old generation */ AllocGen = genInfo.allocbase; /* < AllocGen indicates in delay bucket -> promote */ OldHp = genInfo.oldlim; newscav = genInfo.newgen[genInfo.curnew].newbase; /* Point to (info field of) first closure */ oldscav = genInfo.oldlim + 1; /* Point to (info field of) first closure */ DEBUG_STRING("Setting Evac & Upd CAFs:"); for (CAFptr = sm->CAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { INFO_PTR(CAFptr) = (W_) Caf_Evac_Upd_info; } for (CAFptr = genInfo.NewCAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { INFO_PTR(CAFptr) = (W_) Caf_Evac_Upd_info; } /* FIRST: Evacuate and scavenge OldMutable, Roots, AStk & BStk */ /* Ensure these roots don't use old generation root indirection when evacuated */ Scav = newscav; DEBUG_STRING("Evacuate Roots:"); for (root = 0, rootno = sm->rootno; root < rootno; root++) { P_ evac = sm->roots[root]; if (evac > OldGen) { sm->roots[root] = EVACUATE_CLOSURE(evac); } } #if !defined(PAR) DEBUG_STRING("Evacuate A Stack:"); for (stackptr = MAIN_SpA, botA = stackInfo.botA; SUBTRACT_A_STK(stackptr, botA) >= 0; stackptr = stackptr + AREL(1)) { P_ evac = *stackptr; if (evac > OldGen) { *stackptr = EVACUATE_CLOSURE(evac); } } DEBUG_STRING("Evacuate B Stack:"); bstk_roots = 0; for (updateFramePtr = MAIN_SuB, botB = stackInfo.botB; SUBTRACT_B_STK(updateFramePtr, botB) > 0; /* re-initialiser given explicitly */) { /* Evacuate the thing to be updated */ P_ evac = GRAB_UPDATEE(updateFramePtr); if (evac > OldGen) { PUSH_UPDATEE(updateFramePtr, EVACUATE_CLOSURE(evac)); } bstk_roots++; updateFramePtr = GRAB_SuB(updateFramePtr); } #endif /* PAR */ DEBUG_STRING("Evacuate Mutable Roots:"); mutable = 0; mutptr = sm->OldMutables; prevmut = ((P_)&sm->OldMutables) - FIXED_HS; /* See MUT_LINK */ while ( mutptr ) { /* Scavenge the OldMutable closure */ P_ info = (P_) INFO_PTR(mutptr); StgScavPtr scav_code = SCAV_CODE(info); Scav = mutptr; (scav_code)(); /* Remove from OldMutables if no longer mutable */ /* HACK ALERT: See comment in SMap.lc about why we do this terrible pointer comparison. */ if (info == ImMutArrayOfPtrs_info) { /* ToDo: use different test? (WDP 94/11) */ P_ tmp = mutptr; MUT_LINK(prevmut) = MUT_LINK(mutptr); mutptr = (P_) MUT_LINK(mutptr); MUT_LINK(tmp) = MUT_NOT_LINKED; } else { prevmut = mutptr; mutptr = (P_) MUT_LINK(mutptr); } mutable++; } #ifdef PAR EvacuateLocalGAs(rtsFalse); #else evacSPTable( sm ); #endif /* PAR */ while ((newscav <= ToHp) || (oldscav <= OldHp)) { Scav = newscav; DEBUG_SCAN("Scav: NewScav", Scav, "ToHp", ToHp); while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); newscav = Scav; Scav = oldscav; DEBUG_SCAN("Scav: OldScav", Scav, "OldHp", OldHp); while (Scav <= OldHp) (SCAV_CODE(INFO_PTR(Scav)))(); oldscav = Scav; } /* SECOND: Evacuate & Scavenge CAFs and OldGen roots */ /* Ensure these roots don't use old generation root indirection when evacuated */ Scav = newscav; oldstartToHp = ToHp; oldstartOldHp = OldHp; DEBUG_STRING("Evacuate CAFs and old generation roots:"); /* Evacuate CAFs in allocation region to New semispace */ /* Evacuate CAFs in New semispace to OldGen */ /* OldCAFlist = NewCAFlist ++ OldCAFlist */ /* NewCAFlist = CAFlist */ /* CAFlist = NULL */ alloc_cafs = 0; for (CAFptr = sm->CAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { EVACUATE_CLOSURE(CAFptr); /* evac & upd */ alloc_cafs++; } for (CAFptr = genInfo.NewCAFlist, prevCAF = ((P_)(&genInfo.NewCAFlist)) - FIXED_HS; /* see IND_CLOSURE_LINK */ CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { EVACUATE_CLOSURE(CAFptr); /* evac & upd */ prevCAF = CAFptr; } new_cafs = genInfo.NewCAFno; IND_CLOSURE_LINK(prevCAF) = (W_) genInfo.OldCAFlist; genInfo.OldCAFlist = genInfo.NewCAFlist; genInfo.OldCAFno += genInfo.NewCAFno; genInfo.NewCAFlist = sm->CAFlist; genInfo.NewCAFno = alloc_cafs; sm->CAFlist = NULL; /* Evacuate OldRoots roots to New semispace */ /* Evacuate OldInNew roots to OldGen, discard these roots */ /* OldInNew = OldRoots */ /* OldRoots = 0 */ for (oldroot = genInfo.OldInNew; oldroot; oldroot = (P_) IND_CLOSURE_LINK(oldroot)) { P_ evac = (P_) IND_CLOSURE_PTR(oldroot); if (evac > OldGen) { IND_CLOSURE_PTR(oldroot) = (W_) EVACUATE_CLOSURE(evac); } } new_oldroots = genInfo.OldInNewno; DEBUG_STRING("Scavenge evacuated old generation roots:"); while ((newscav <= ToHp) || (oldscav <= OldHp)) { Scav = newscav; DEBUG_SCAN("Scav: NewScav", Scav, "ToHp", ToHp); while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); newscav = Scav; Scav = oldscav; DEBUG_SCAN("Scav: OldScav", Scav, "OldHp", OldHp); while (Scav <= OldHp) (SCAV_CODE(INFO_PTR(Scav)))(); oldscav = Scav; } old_words = OldHp - oldstartOldHp; /* + (ToHp - oldstartToHp) */ /* record newly promoted mutuple roots */ MUT_LINK(prevmut) = (W_) genInfo.PromMutables; genInfo.PromMutables = 0; promote = OldHp - genInfo.oldlim; resident = (ToHp - genInfo.newgen[genInfo.curnew].newbase + 1) + promote; genInfo.newgen[genInfo.curnew].newlim = ToHp; genInfo.oldlim = OldHp; genInfo.minor_since_major++; #ifdef PAR RebuildGAtables(rtsFalse); #else reportDeadMallocPtrs(sm->MallocPtrList, sm->OldMallocPtrList, &(sm->OldMallocPtrList)); sm->MallocPtrList = NULL; /* all (new) MallocPtrs have been promoted */ #endif /* PAR */ if (SM_stats_verbose) { char minor_str[BIG_STRING_LEN]; #ifndef PAR sprintf(minor_str, "%6lu %4lu %4lu %4ld %3ld %3ld %4ld %3ld %3ld %6ld Minor", promote*sizeof(W_), genInfo.OldInNewno - alloc_oldroots, (I_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, alloc_cafs + new_cafs, mutable, alloc_oldroots, new_oldroots, old_words*sizeof(W_)); #else /* ToDo: come up with some interesting statistics for the parallel world */ sprintf(minor_str, "%6lu %4lu %4lu %4ld %3ld %3ld %4ld %3ld %3ld %6ld Minor", promote*sizeof(W_), genInfo.OldInNewno - alloc_oldroots, 0, 0, sm->rootno, alloc_cafs + new_cafs, mutable, alloc_oldroots, new_oldroots, old_words*sizeof(W_)); #endif stat_endGC(alloc, collect, resident, minor_str); } else { stat_endGC(alloc, collect, resident, ""); } /* ToDo: Decide to do major early ! */ if (genInfo.oldlim <= genInfo.oldthresh && !do_full_collection) { sm->hp = hp_start = genInfo.allocbase - 1; sm->hplim = genInfo.alloclim; sm->OldLim = genInfo.oldlim; if (SM_trace) fprintf(stderr, "GEN End: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh, (W_) genInfo.newgen[genInfo.curnew].newbase, (W_) genInfo.newgen[genInfo.curnew].newlim, (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); RESTORE_REGS(&ScavRegDump); /* Restore Registers */ return GC_SUCCESS; /* Heap OK -- Enough space to continue */ } DEBUG_STRING("Major Collection Required"); stat_startGC(0); alloc = genInfo.oldlim - genInfo.oldbase + 1; /* Zero bit vector for marking phase of major collection */ bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); { BitWord *ptr = genInfo.bit_vect, *end = genInfo.bit_vect + bit_words; while (ptr < end) { *(ptr++) = 0; }; } /* Set are for old gen CAFs to be linked */ CAFlocs = (PP_) genInfo.newgen[(genInfo.curnew + 1) % 2].newbase; if (genInfo.new_words < genInfo.OldCAFno) { fprintf(stderr, "colectHeap: Too many CAFs %ld to link in new semi-space %ld\n", genInfo.OldCAFno, genInfo.alloc_words); fprintf(stderr, " Rerun using +RTS -A to increase allocation area\n"); EXIT(EXIT_FAILURE); } /* Change old generation root indirections to special OldRoot indirections */ /* These will be marked and not short circuted (like SPEC 2,1 closure) */ for (oldroot = genInfo.OldInNew; oldroot; oldroot = (P_) IND_CLOSURE_LINK(oldroot)) { INFO_PTR(oldroot) = (W_) OldRoot_info; } /* Discard OldInNew roots: Scanning OldRoots will reconstruct live OldInNew root list */ genInfo.OldInNew = 0; genInfo.OldInNewno = 0; /* Discard OldMutable roots: Scanning Mutables will reconstruct live OldMutables root list */ sm->OldMutables = 0; /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAV_REG_MAP */ RESTORE_REGS(&ScavRegDump); markHeapRoots(sm, genInfo.NewCAFlist, genInfo.OldCAFlist, genInfo.oldbase, genInfo.oldlim, genInfo.bit_vect); SAVE_REGS(&ScavRegDump); /* end of bracket */ #ifndef PAR sweepUpDeadMallocPtrs(sm->OldMallocPtrList, appelInfo.oldbase, appelInfo.bits ); #endif /* !PAR */ oldlim = genInfo.oldlim; DEBUG_STRING("Linking Dummy CAF Ptr Locations:"); CAFloc = CAFlocs; for (CAFptr = genInfo.OldCAFlist; CAFptr; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { DEBUG_LINK_CAF(CAFptr, CAFloc); *CAFloc = (P_) IND_CLOSURE_PTR(CAFptr); LINK_LOCATION_TO_CLOSURE(CAFloc, oldlim); CAFloc++; } DEBUG_STRING("Linking Roots:"); for (root = 0; root < sm->rootno; root++) { LINK_LOCATION_TO_CLOSURE(sm->roots+root, oldlim); } #ifdef PAR fall over here until we figure out how to link GAs #else DEBUG_STRING("Linking Stable Pointer Table:"); LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable, oldlim); DEBUG_STRING("Linking A Stack:"); for (stackptr = MAIN_SpA; SUBTRACT_A_STK(stackptr, stackInfo.botA) >= 0; stackptr = stackptr + AREL(1)) { LINK_LOCATION_TO_CLOSURE(stackptr, oldlim); } DEBUG_STRING("Linking B Stack:"); for (updateFramePtr = MAIN_SuB; /* SuB points to topmost update frame */ SUBTRACT_B_STK(updateFramePtr, stackInfo.botB) > 0; /* re-initialiser given explicitly */) { P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE); LINK_LOCATION_TO_CLOSURE(updateClosurePtr, oldlim); updateFramePtr = GRAB_SuB(updateFramePtr); } #endif /* PAR */ /* Do Inplace Compaction */ /* Returns start of next closure, -1 gives last allocated word */ genInfo.oldlim = Inplace_Compaction(genInfo.oldbase, genInfo.oldlim, genInfo.newgen[genInfo.curnew].newbase, genInfo.newgen[genInfo.curnew].newlim, genInfo.bit_vect, bit_words) - 1; resident = (genInfo.oldlim - genInfo.oldbase) + 1; total_resident = genInfo.newgen[genInfo.curnew].newlim - genInfo.newgen[genInfo.curnew].newbase + 1 + resident; sm->hp = hp_start = genInfo.allocbase - 1; sm->hplim = genInfo.alloclim; sm->OldLim = genInfo.oldlim; genInfo.oldwas = genInfo.oldlim; genInfo.minor_since_major = 0; if (SM_stats_verbose) { char major_str[BIG_STRING_LEN]; #ifndef PAR sprintf(major_str, "%6d %4ld %4u %4ld %3ld %3ld %4d %3d %3d %6.6s *Major* %4.1f%%", 0, genInfo.OldInNewno, (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno, 0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100); #else sprintf(major_str, "%6d %4ld %4u %4ld %3ld %3ld %4d %3d %3d %6.6s *Major* %4.1f%%", 0, genInfo.OldInNewno, 0, 0, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno, 0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100); #endif stat_endGC(0, alloc, resident, major_str); } else { stat_endGC(0, alloc, resident, ""); } if (SM_trace) fprintf(stderr, "GEN Major: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh, (W_) genInfo.newgen[genInfo.curnew].newbase, (W_) genInfo.newgen[genInfo.curnew].newlim, (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); #ifdef DEBUG /* To help flush out bugs, we trash the part of the heap from which we're about to start allocating. */ TrashMem(sm->hp+1, sm->hplim); #endif /* DEBUG */ RESTORE_REGS(&ScavRegDump); /* Restore Registers */ if (genInfo.oldlim > genInfo.oldthresh) return GC_HARD_LIMIT_EXCEEDED; /* Heap exhausted */ else return GC_SUCCESS; /* Heap OK */ } #endif /* GCgn */ \end{code}