X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fstorage%2FSMap.lc;fp=ghc%2Fruntime%2Fstorage%2FSMap.lc;h=0000000000000000000000000000000000000000;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=802c296f5a5612b7e19ef32e1bfa870f0c455cd0;hpb=967cc47f37cb93a5e2b6df7822c9a646f0428247;p=ghc-hetmet.git

diff --git a/ghc/runtime/storage/SMap.lc b/ghc/runtime/storage/SMap.lc
deleted file mode 100644
index 802c296..0000000
--- a/ghc/runtime/storage/SMap.lc
+++ /dev/null
@@ -1,752 +0,0 @@
-***************************************************************************
-
-                      APPEL'S 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.
-
-***************************************************************************
-
-\begin{code}
-#if defined(GCap)
-
-#define  SCAV_REG_MAP
-#include "SMinternal.h"
-#include "SMcopying.h"
-#include "SMcompacting.h"
-#include "SMextn.h"
-
-REGDUMP(ScavRegDump);
-
-appelData appelInfo = {0, 0, 0, 0, 0,
-		       0, 0, 0, 0, 0, 0, 0, 0, 0,
-		       0, {{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 */
-
-static I_ allocd_since_last_major_GC = 0;
-	/* words alloced since last major GC; used when forcing GC */
-
-#if defined(DEBUG)
-void
-debug_look_for (start, stop, villain)
-  P_ start, stop, villain;
-{
-    P_ i;
-    for (i = start; i <= stop; i++) {
-	if ( (P_) *i == villain ) {
-	    fprintf(stderr, "* %x : %x\n", i, villain);
-	}
-    }
-}
-#endif
-
-rtsBool
-initHeap(smInfo * sm)
-{
-    if (heap_space == 0) { /* allocates if it doesn't already exist */
-
-	/* 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)");
-
-	/* ToDo (ADR): trash entire heap contents */
-
-	if (RTSflags.GcFlags.force2s) {
-	    stat_init("TWOSPACE(APPEL)",
-		      " No of Roots  Caf   Caf    Astk   Bstk",
-		      "Astk Bstk Reg  No  bytes  bytes  bytes");
-	} else {
-	    stat_init("APPEL",
-		      " No of Roots  Caf  Mut-  Old  Collec  Resid",
-		      "Astk Bstk Reg  No  able  Gen   tion   %heap");
-	}
-    }
-    sm->hardHpOverflowSize = 0;
-
-    if (RTSflags.GcFlags.force2s) {
-	I_ semi_space_words = RTSflags.GcFlags.heapSize / 2;
-	appelInfo.space[0].base = HEAP_FRAME_BASE(heap_space, semi_space_words);
-	appelInfo.space[1].base = HEAP_FRAME_BASE(heap_space + semi_space_words, semi_space_words);
-	appelInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, semi_space_words);
-	appelInfo.space[1].lim = HEAP_FRAME_LIMIT(heap_space + semi_space_words, semi_space_words);
-	appelInfo.semi_space = 0;
-	appelInfo.oldlim = heap_space - 1;  /* Never in old generation */
-
-	sm->hp = hp_start = appelInfo.space[appelInfo.semi_space].base - 1;
-
-	if (! RTSflags.GcFlags.allocAreaSizeGiven) {
-	    sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
-	} else {
-	    sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
-
-	    RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
-
-	    if (sm->hplim > appelInfo.space[appelInfo.semi_space].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 {
-              /* no point in forcing GC, 
-                 as the semi-space is smaller than forcingInterval */
-              RTSflags.GcFlags.forceGC = rtsFalse;
-           }
-        }
-
-	sm->OldLim = appelInfo.oldlim;
-	sm->CAFlist = NULL;
-
-#ifndef PAR
-	initExtensions( sm );
-#endif
-
-	if (RTSflags.GcFlags.trace) {
-	    fprintf(stderr, "APPEL(2s) Heap: 0x%lx .. 0x%lx\n",
-		    (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
-	    fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
-		    appelInfo.semi_space,
-		    (W_) appelInfo.space[appelInfo.semi_space].base,
-		    (W_) appelInfo.space[appelInfo.semi_space].lim,
-		    (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
-	}
-	return rtsTrue;
-    }
-
-
-/* So not forced 2s */
-
-    appelInfo.newlim  = heap_space + RTSflags.GcFlags.heapSize - 1;
-    if (RTSflags.GcFlags.allocAreaSizeGiven) {
-	appelInfo.newfixed = RTSflags.GcFlags.allocAreaSize;
-	appelInfo.newmin   = RTSflags.GcFlags.allocAreaSize;
-        appelInfo.newbase  = heap_space + RTSflags.GcFlags.heapSize - appelInfo.newfixed;
-    } else {
-	appelInfo.newfixed = 0;
-	appelInfo.newmin   = RTSflags.GcFlags.minAllocAreaSize;
-	appelInfo.newbase  = heap_space + (RTSflags.GcFlags.heapSize / 2);
-    }
-
-    appelInfo.oldbase = heap_space;
-    appelInfo.oldlim  = heap_space - 1;
-    appelInfo.oldlast = heap_space - 1;
-    appelInfo.oldmax  = heap_space - 1 + RTSflags.GcFlags.heapSize - 2*appelInfo.newmin;
-
-    if (appelInfo.oldbase > appelInfo.oldmax) {
-	fprintf(stderr, "Not enough heap for requested/minimum allocation area\n");
-	fprintf(stderr, "heap_space=%ld\n", (W_) heap_space);
-	fprintf(stderr, "heapSize=%ld\n", RTSflags.GcFlags.heapSize);
-	fprintf(stderr, "newmin=%ld\n", appelInfo.newmin);
-	return rtsFalse;
-    }
-
-    appelInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
-    appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
-
-    if (appelInfo.bit_words > appelInfo.newmin)
-        appelInfo.oldmax = heap_space - 1 + RTSflags.GcFlags.heapSize - appelInfo.bit_words - appelInfo.newmin;
-
-    if (RTSflags.GcFlags.specifiedOldGenSize) {
-	appelInfo.oldthresh = heap_space -1 + RTSflags.GcFlags.specifiedOldGenSize;
-	if (appelInfo.oldthresh > appelInfo.oldmax) {
-	    fprintf(stderr, "Not enough heap for requested major resid size\n");
-	    return rtsFalse;
-	}
-    } else {
-	appelInfo.oldthresh = heap_space + RTSflags.GcFlags.heapSize * 2 / 3; /* Initial threshold -- 2/3rds */
-	if (appelInfo.oldthresh > appelInfo.oldmax)
-	    appelInfo.oldthresh = appelInfo.oldmax;
-    }
-
-    sm->hp = hp_start = appelInfo.newbase - 1;
-    sm->hplim = appelInfo.newlim;
-
-    if (RTSflags.GcFlags.forceGC
-     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
-	sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
-    }
-
-    sm->OldLim = appelInfo.oldlim;
-
-    sm->CAFlist = NULL;
-    appelInfo.OldCAFlist = NULL;
-    appelInfo.OldCAFno = 0;
-
-#ifndef PAR
-    initExtensions( sm );
-#endif
-
-    appelInfo.PromMutables = 0;
-
-    if (RTSflags.GcFlags.trace) {
-	fprintf(stderr, "APPEL Heap: 0x%lx .. 0x%lx\n",
-		(W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
-	fprintf(stderr, "Initial: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n         hp 0x%lx, hplim 0x%lx\n",
-		(W_) appelInfo.newbase, (W_) appelInfo.newlim,
-		(W_) appelInfo.oldbase, (W_) appelInfo.oldlim,
-		(W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
-		(W_) sm->hp, (W_) sm->hplim);
-    }
-
-    return rtsTrue; /* OK */
-}
-
-static I_
-collect2s(W_ reqsize, smInfo *sm)
-{
-    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 in B stack */
-
-    SAVE_REGS(&ScavRegDump);        /* Save registers */
-
-#if defined(PROFILING)
-    if (interval_expired) { heap_profile_setup(); }
-#endif  /* PROFILING */
-  
-    if (RTSflags.GcFlags.trace)
-	fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
-		appelInfo.semi_space,
-		(W_) appelInfo.space[appelInfo.semi_space].base,
-		(W_) appelInfo.space[appelInfo.semi_space].lim,
-		(W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_)));
-
-    alloc = sm->hp - hp_start;
-    stat_startGC(alloc);
-
-    appelInfo.semi_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
-    ToHp = appelInfo.space[appelInfo.semi_space].base - 1;
-    Scav = appelInfo.space[appelInfo.semi_space].base;
-    OldGen = sm->OldLim; /* always evac ! */
-    
-    SetCAFInfoTables( sm->CAFlist );
-#ifdef PAR
-    EvacuateLocalGAs(rtsTrue);
-#else
-    /* evacSPTable( sm ); StablePointerTable now accessable in sm->roots SOF 4/96 */
-#endif /* PAR */
-    EvacuateRoots( sm->roots, sm->rootno );
-#if defined(GRAN)
-    EvacuateEvents();
-#endif
-#if defined(CONCURRENT)
-    EvacuateSparks();
-#endif
-#if !defined(PAR)
-    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 - (appelInfo.space[appelInfo.semi_space].base - 1);
-    DO_MAX_RESIDENCY(resident); /* stats only */
-
-    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
-	sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
-	free_space = sm->hplim - sm->hp;
-    } else {
-	sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
-	if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
-	    free_space = 0;
-	} else {
-	    free_space = RTSflags.GcFlags.allocAreaSize;
-	}
-    }
-
-    if (RTSflags.GcFlags.forceGC
-     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
-	sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
-    }
-
-    if (RTSflags.GcFlags.giveStats) {
-	char comment_str[BIG_STRING_LEN];
-#if !defined(PAR)
-	sprintf(comment_str, "%4lu %4ld %3ld %3ld %6lu %6lu %6lu  2s",
-		(W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
-		bstk_roots, sm->rootno,
-		caf_roots, extra_caf_words*sizeof(W_),
-		(W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
-		(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, 0L, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0L, 0L);
-
-#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, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
-		appelInfo.semi_space,
-		(W_) appelInfo.space[appelInfo.semi_space].base,
-		(W_) appelInfo.space[appelInfo.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, and all of the space
-           we just came from. */
-    {
-      I_ old_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
-
-      TrashMem(appelInfo.space[old_space].base, appelInfo.space[old_space].lim);
-      TrashMem(sm->hp+1, sm->hplim);
-    }
-#endif /* DEBUG */
-
-    RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
-
-    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
-      return( GC_HARD_LIMIT_EXCEEDED );	/* Heap absolutely exhausted */
-    else {
-	if (reqsize + sm->hardHpOverflowSize > free_space) {
-	  return( GC_SOFT_LIMIT_EXCEEDED );	/* Heap nearly exhausted */
-	} else {
-	  return( GC_SUCCESS );          /* Heap OK */
-	}
-    }
-}
-
-
-I_
-collectHeap(reqsize, sm, do_full_collection)
-    W_ reqsize;
-    smInfo *sm;
-    rtsBool do_full_collection; /* do a major collection regardless? */
-{
-    I_ bstk_roots, caf_roots, mutable, old_words;
-    P_ old_start, mutptr, prevmut;
-    P_ CAFptr, prevCAF;
-
-    I_ alloc, 		/* Number of words allocated since last GC */
-	resident;	/* Number of words remaining after GC */
-
-    fflush(stdout);     /* Flush stdout at start of GC */
-
-    if (RTSflags.GcFlags.force2s) {
-	return collect2s(reqsize, sm);
-    }
-
-    SAVE_REGS(&ScavRegDump); /* Save registers */
-
-    if (RTSflags.GcFlags.trace)
-	fprintf(stderr, "Start: newbase 0x%lx, newlim 0x%lx\n        hp 0x%lx, hplim 0x%lx, req %lu\n",
-		(W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
-
-    alloc = sm->hp - hp_start;
-    stat_startGC(alloc);
-
-    allocd_since_last_major_GC += sm->hplim - hp_start;
-    /* this is indeed supposed to be less precise than alloc above */
-
-    /* COPYING COLLECTION */
-
-    /* Set ToHp to end of old gen */
-    ToHp = appelInfo.oldlim;
-
-    /* Set OldGen register so we only evacuate new gen closures */
-    OldGen = appelInfo.oldlim;
-
-    /* FIRST: Evacuate and Scavenge CAFs and roots in the old generation */
-    old_start = ToHp;
-
-    SetCAFInfoTables( sm->CAFlist );
-
-    DEBUG_STRING("Evacuate CAFs:");
-    caf_roots = 0;
-    CAFptr = sm->CAFlist;
-    prevCAF = ((P_)(&sm->CAFlist)) - FIXED_HS; /* see IND_CLOSURE_LINK */
-    while (CAFptr) {
-      EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
-      caf_roots++;
-      prevCAF = CAFptr;
-      CAFptr = (P_) IND_CLOSURE_LINK(CAFptr);
-    }
-    IND_CLOSURE_LINK(prevCAF) = (W_) appelInfo.OldCAFlist;
-    appelInfo.OldCAFlist = sm->CAFlist;
-    appelInfo.OldCAFno += caf_roots;
-    sm->CAFlist = NULL;
-
-    DEBUG_STRING("Evacuate Mutable Roots:");
-    mutable = 0;
-    mutptr = sm->OldMutables;
-    /* Clever, but completely illegal: */
-    prevmut = ((P_)&sm->OldMutables) - FIXED_HS;
-				/* See MUT_LINK */
-    while ( mutptr ) {
-
-	/* Scavenge the OldMutable */
-	P_ info = (P_) INFO_PTR(mutptr);
-	StgScavPtr scav_code = SCAV_CODE(info);
-	Scav = mutptr;
-	(scav_code)();
-
-	/* Remove from OldMutables if no longer mutable */
-	if (!IS_MUTABLE(info)) {
-    	    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++;
-    }
-
-#if 0 && defined(GRAN)
-    {
-      extern ex_RBH_q;
-      closq prev_ptr, clos_ptr;
-
-      DEBUG_STRING("Evacuate reverted RBHs:");
-      clos_ptr = ex_RBH_q;
-      while ( clos_ptr ) {
-
-	/* Scavenge the OldMutable */
-	P_ info = (P_) INFO_PTR(CLOS_CLOSURE(clos_ptr));
-	StgScavPtr scav_code = SCAV_CODE(info);
-	Scav = CLOS_CLOSURE(clos_ptr);
-	(scav_code)();
-
-	/* No mutable closure are put on the ex_RBH_q */
-	/* ASSERT(IS_MUTABLE(info)); */
-        prev_ptr = clos_ptr;
-        clos_ptr = CLOS_NEXT(clos_ptr);
-        free(prev_ptr);
-      }
-      ex_RBH_q = NULL;
-    }
-#endif /* GRAN */
-
-#ifdef PAR
-    EvacuateLocalGAs(rtsFalse);
-#else
-    /* evacSPTable( sm ); SP table is now in sm->roots*/
-#endif /* PAR */
-
-    DEBUG_STRING("Scavenge evacuated old generation roots:");
-
-    Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
-
-    Scavenge();
-
-    old_words = ToHp - old_start;
-
-    /* PROMOTE closures rooted in the old generation and reset list of old gen roots */
-
-    appelInfo.oldlim = ToHp;
-
-    /* SECOND: Evacuate and scavenge remaining roots
-               These may already have been evacuated -- just get new address
-    */
-
-    EvacuateRoots( sm->roots, sm->rootno );
-
-#if defined(GRAN)
-    EvacuateEvents();
-#endif
-#if defined(CONCURRENT)
-    EvacuateSparks();
-#endif
-#if !defined(PAR)
-    EvacuateAStack( MAIN_SpA, stackInfo.botA );
-    EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
-    /* ToDo: Optimisation which squeezes out garbage update frames */
-#endif	/* PAR */
-
-    Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
-
-    Scavenge();
-
-    appelInfo.oldlim = ToHp;
-
-    /* record newly promoted mutuple roots */
-    MUT_LINK(prevmut) = (W_) appelInfo.PromMutables;
-    appelInfo.PromMutables = 0;
-
-    /* set new generation base, if not fixed */
-    if (! appelInfo.newfixed) {
-	appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
-    }
-
-#ifdef PAR
-    RebuildGAtables(rtsFalse);
-#else
-    reportDeadForeignObjs(sm->ForeignObjList, 
-  		          sm->OldForeignObjList, 
-			  &(sm->OldForeignObjList));
-    sm->ForeignObjList = NULL;   /* all (new) ForeignObjs have been promoted */
-#endif /* PAR */
-
-    resident = appelInfo.oldlim - sm->OldLim;
-    /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */
-
-    if (RTSflags.GcFlags.giveStats) {
-	char minor_str[BIG_STRING_LEN];
-#if !defined(PAR)
-	sprintf(minor_str, "%4lu %4ld %3ld %3ld  %4ld        Minor",
-	      (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
-	      bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */
-#else
-	/* ToDo: come up with some interesting statistics for the parallel world */
-	sprintf(minor_str, "%4u %4ld %3ld %3ld  %4ld        Minor",
-		0, 0L, sm->rootno, caf_roots, mutable);
-#endif
-	stat_endGC(alloc, alloc, resident, minor_str);
-    } else {
-	stat_endGC(alloc, alloc, resident, "");
-    }
-
-    /* Note: if do_full_collection we want to force a full collection. [ADR] */
-
-    if (RTSflags.GcFlags.forceGC
-     && allocd_since_last_major_GC >= RTSflags.GcFlags.forcingInterval) { 
-       do_full_collection = 1;
-    }
-
-    if ((appelInfo.oldlim < appelInfo.oldthresh) &&
-	(reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
-	(! do_full_collection) ) {
-
-	sm->hp = hp_start = appelInfo.newbase - 1;
-	sm->hplim = appelInfo.newlim;
-
-        if (RTSflags.GcFlags.forceGC
-	 && (allocd_since_last_major_GC + (sm->hplim - hp_start) > RTSflags.GcFlags.forcingInterval)) {
-	    sm->hplim = sm->hp + (RTSflags.GcFlags.forcingInterval - allocd_since_last_major_GC);
-        }
-
-	sm->OldLim = appelInfo.oldlim;
-
-	if (RTSflags.GcFlags.trace) {
-	    fprintf(stderr, "Minor: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
-		    (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
-		    (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
-		    (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
-		    (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 */
-
-	return GC_SUCCESS;           /* Heap OK -- Enough space to continue */
-    }
-
-    DEBUG_STRING("Major Collection Required");
-
-    allocd_since_last_major_GC = 0;
-
-    stat_startGC(0);
-
-    alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1;
-
-    appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
-    appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
-			  /* For some reason, this doesn't seem to use the last
-			     allocatable word at appelInfo.newlim */
-
-    if (appelInfo.bits <= appelInfo.oldlim) {
-	fprintf(stderr, "APPEL Major: Not enough space for bit vector\n");
-	return GC_HARD_LIMIT_EXCEEDED;
-    }
-
-    /* Zero bit vector for marking phase of major collection */
-    { BitWord *ptr = appelInfo.bits,
-	      *end = appelInfo.bits + appelInfo.bit_words;
-      while (ptr < end) { *(ptr++) = 0; };
-    }
-    
-#ifdef HAVE_VADVISE
-    vadvise(VA_ANOM);
-#endif
-
-    /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAV_REG_MAP */
-    RESTORE_REGS(&ScavRegDump);
-
-    markHeapRoots(sm, 
-		  appelInfo.OldCAFlist,
-		  NULL,
-		  appelInfo.oldbase,
-		  appelInfo.oldlim,
-		  appelInfo.bits);
-
-    SAVE_REGS(&ScavRegDump);
-    /* end of bracket */
-
-#ifndef PAR
-    sweepUpDeadForeignObjs(sm->OldForeignObjList, 
-			   appelInfo.oldbase, 
-			   appelInfo.bits 
-			  );
-#endif /* !PAR */
-
-    /* Reset OldMutables -- this will be reconstructed during scan */
-    sm->OldMutables = 0;
-
-    LinkCAFs(appelInfo.OldCAFlist);
-
-    LinkRoots( sm->roots, sm->rootno );
-#if defined(GRAN)
-    LinkEvents();
-#endif
-#if defined(CONCURRENT)
-    LinkSparks();
-#endif
-#ifdef PAR
-    LinkLiveGAs(appelInfo.oldbase, appelInfo.bits);
-#else
-/*  stable pointers now included in sm->roots -- SOF
-    DEBUG_STRING("Linking Stable Pointer Table:");
-    LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
-*/
-    LinkAStack( MAIN_SpA, stackInfo.botA );
-    LinkBStack( MAIN_SuB, stackInfo.botB );
-#endif
-
-    /* Do Inplace Compaction */
-    /* Returns start of next closure, -1 gives last allocated word */
-
-    appelInfo.oldlim = Inplace_Compaction(appelInfo.oldbase,
-					  appelInfo.oldlim,
-					  0, 0,
-					  appelInfo.bits,
-					  appelInfo.bit_words
-#ifndef PAR
-					  ,&(sm->OldForeignObjList)
-#endif
-					  ) - 1;
-
-    appelInfo.oldlast = appelInfo.oldlim; 
-    resident = (appelInfo.oldlim - appelInfo.oldbase) + 1;
-    DO_MAX_RESIDENCY(resident); /* stats only */
-
-    /* set new generation base, if not fixed */
-    if (! appelInfo.newfixed) {
-	appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
-    }
-
-    /* set major threshold, if not fixed */
-    /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */
-    if (! RTSflags.GcFlags.specifiedOldGenSize) {
-	appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3;
-	if (appelInfo.oldthresh > appelInfo.oldmax)
-	    appelInfo.oldthresh = appelInfo.oldmax;
-    }
-
-    sm->hp = hp_start = appelInfo.newbase - 1;
-    sm->hplim = appelInfo.newlim;
-    
-    if (RTSflags.GcFlags.forceGC
-     && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
-	sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
-    }
-
-    sm->OldLim = appelInfo.oldlim;
-
-#ifdef HAVE_VADVISE
-    vadvise(VA_NORM);
-#endif
-
-    if (RTSflags.GcFlags.giveStats) {
-	char major_str[BIG_STRING_LEN];
-#if !defined(PAR)
-	sprintf(major_str, "%4lu %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
-		(W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
-		bstk_roots, sm->rootno, appelInfo.OldCAFno,
-		0, 0, resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
-#else
-	/* ToDo: come up with some interesting statistics for the parallel world */
-	sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
-		0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0,
-		resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
-#endif
-
-	stat_endGC(0, alloc, resident, major_str);
-    } else { 
-	stat_endGC(0, alloc, resident, "");
-    }
-
-    if (RTSflags.GcFlags.trace) {
-	fprintf(stderr, "Major: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
-		(W_) appelInfo.newbase,   (W_) appelInfo.newlim,
-		(W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
-		(W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
-		(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 ((appelInfo.oldlim > appelInfo.oldmax)
-	|| (reqsize > sm->hplim - sm->hp) ) {
-      return( GC_HARD_LIMIT_EXCEEDED );	/* Heap absolutely exhausted */
-    } else if (reqsize + sm->hardHpOverflowSize > sm->hplim - sm->hp) {
-      return( GC_SOFT_LIMIT_EXCEEDED );	/* Heap nearly exhausted */
-    } else {
-      return( GC_SUCCESS );          /* Heap OK */
-    /* linked = IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) !=
-       MUT_NOT_LINKED; */
-    }
-}
-
-#endif /* GCap */
-
-\end{code}