+++ /dev/null
-***************************************************************************
-
- TWO SPACE COLLECTION
-
-***************************************************************************
-
-\begin{code}
-#if defined(GC2s)
-
-#define SCAV_REG_MAP
-#include "SMinternal.h"
-#include "SMcopying.h"
-#include "SMextn.h"
-
-REGDUMP(ScavRegDump);
-
-I_ semispace = 0; /* 0 or 1 */
-semispaceData semispaceInfo[2]
- = {{0,0}, {0,0}};
-
-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 */
-
-
-rtsBool
-initHeap(smInfo * sm)
-{
- if (heap_space == 0) { /* allocates if it doesn't already exist */
-
- I_ semispaceSize = RTSflags.GcFlags.heapSize / 2;
-
- /* Allocate the roots space */
- sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
-
- /* Allocate the heap */
- heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
- "initHeap (heap)");
-
- /* Define the semi-spaces */
- semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize);
- semispaceInfo[1].base = HEAP_FRAME_BASE(heap_space + semispaceSize, semispaceSize);
- semispaceInfo[0].lim = HEAP_FRAME_LIMIT(heap_space, semispaceSize);
- semispaceInfo[1].lim = HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize);
-
- stat_init("TWOSPACE",
- " No of Roots Caf Caf Astk Bstk",
- "Astk Bstk Reg No bytes bytes bytes");
- }
-
- /* Initialise heap pointer and limit */
- sm->hp = hp_start = semispaceInfo[semispace].base - 1;
- sm->hardHpOverflowSize = 0;
-
- if (! RTSflags.GcFlags.allocAreaSizeGiven) {
- sm->hplim = semispaceInfo[semispace].lim;
- } else {
- sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
-
- RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
-
- if (sm->hplim > semispaceInfo[semispace].lim) {
- fprintf(stderr, "Not enough heap for requested alloc size\n");
- return rtsFalse;
- }
- }
-
- if (RTSflags.GcFlags.forceGC) {
- if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
- sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
- } else {
- RTSflags.GcFlags.forceGC = rtsFalse;
- /* forcing GC has no effect, as semi-space is smaller than forcingInterval */
- }
- }
-
- sm->CAFlist = NULL;
-
-#ifndef PAR
- initExtensions( sm );
-#endif /* !PAR */
-
- if (RTSflags.GcFlags.trace) {
- fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n 0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
- (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim,
- (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim);
- fprintf(stderr, "TWO SPACE Initial: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n",
- semispace,
- (W_) semispaceInfo[semispace].base,
- (W_) semispaceInfo[semispace].lim,
- (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
- }
-
- return rtsTrue; /* OK */
-}
-
-I_
-collectHeap(reqsize, sm, do_full_collection)
- W_ reqsize;
- smInfo *sm;
- rtsBool do_full_collection; /* ignored */
-{
- 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 */
- extra_caf_words,/* Extra words referenced from CAFs */
- caf_roots, /* Number of CAFs */
- bstk_roots; /* Number of update frames on B stack */
-
- fflush(stdout); /* Flush stdout at start of GC */
- SAVE_REGS(&ScavRegDump); /* Save registers */
-
-#if defined(PROFILING)
- if (interval_expired) { heap_profile_setup(); }
-#endif /* PROFILING */
-
- if (RTSflags.GcFlags.trace)
- fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n",
- semispace, (W_) semispaceInfo[semispace].base,
- (W_) semispaceInfo[semispace].lim,
- (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
-
- alloc = sm->hp - hp_start;
- stat_startGC(alloc);
-
- /* Set Up For Collecting:
- - Flip Spaces
- - Set ToHp to point one below bottom of to-space (last allocated)
- - Set CAFs to Evac & Upd
- */
-
- semispace = NEXT_SEMI_SPACE(semispace);
- ToHp = semispaceInfo[semispace].base - 1;
- Scav = semispaceInfo[semispace].base;
-
- SetCAFInfoTables( sm->CAFlist );
-#ifdef PAR
- EvacuateLocalGAs(rtsTrue);
-#else
- /* evacSPTable( sm ); stable pointers now reachable via sm->roots */
-#endif /* PAR */
- EvacuateRoots( sm->roots, sm->rootno );
-#if defined(GRAN)
- EvacuateEvents();
-#endif
-#if defined(CONCURRENT)
- EvacuateSparks();
-#endif
-#if !defined(PAR) /* && !defined(GRAN) */
- EvacuateAStack( MAIN_SpA, stackInfo.botA );
- EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
-#endif /* !PAR */
-
- Scavenge();
-
- EvacAndScavengeCAFs( sm->CAFlist, &extra_caf_words, &caf_roots );
-
-#ifdef PAR
- RebuildGAtables(rtsTrue);
-#else
- reportDeadForeignObjs(sm->ForeignObjList, NULL, &(sm->ForeignObjList) );
-#endif /* PAR */
-
- /* TIDY UP AND RETURN */
-
- sm->hp = hp_start = ToHp; /* Last allocated word */
-
- resident = sm->hp - (semispaceInfo[semispace].base - 1);
- DO_MAX_RESIDENCY(resident); /* stats only */
-
- if (! RTSflags.GcFlags.allocAreaSizeGiven) {
- sm->hplim = semispaceInfo[semispace].lim;
- free_space = sm->hplim - sm->hp;
- } else {
- sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
- if (sm->hplim > semispaceInfo[semispace].lim) {
- free_space = 0;
- } else {
- free_space = RTSflags.GcFlags.allocAreaSize;
- }
- }
-
- if (RTSflags.GcFlags.giveStats) {
- char comment_str[BIG_STRING_LEN];
-#ifndef PAR
- sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
- (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",
- 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
-#endif
-
-#if defined(PROFILING)
- if (interval_expired) { strcat(comment_str, " prof"); }
-#endif
-
- stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
- } else {
- stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
- }
-
-#if defined(PROFILING) || defined(PAR)
- if (interval_expired) {
-#if defined(PROFILING)
- heap_profile_done();
-#endif
- report_cc_profiling(0 /*partial*/);
- }
-#endif /* PROFILING */
-
- if (RTSflags.GcFlags.trace)
- fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n",
- semispace, (W_) semispaceInfo[semispace].base,
- (W_) semispaceInfo[semispace].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 and all of the other semispace. */
- TrashMem(sm->hp+1, sm->hplim);
- TrashMem(semispaceInfo[NEXT_SEMI_SPACE(semispace)].base,
- semispaceInfo[NEXT_SEMI_SPACE(semispace)].lim);
-#endif /* DEBUG */
-
- RESTORE_REGS(&ScavRegDump); /* Restore Registers */
-
- if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_sapce < reqsize)
- return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
-
- else {
- if (RTSflags.GcFlags.forceGC
- && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
- sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
- }
-
- if (reqsize + sm->hardHpOverflowSize > free_space) {
- return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */
- } else {
- return( GC_SUCCESS ); /* Heap OK */
- }
- }
-}
-
-#endif /* GC2s */
-\end{code}
projects / ghc-hetmet.git / blobdiff