***************************************************************************

                      COMPACTING GARBAGE COLLECTION

Additional Global Data Requirements:
  ++ All the root locations are in malloced space (and info tables in
     static data space). This is to simplify the location list end test.

***************************************************************************

[Someone needs to document this too. KH]

\begin{code}
#if defined(GC1s)

ToDo:  Soft heap limits

#define  SCAN_REG_DUMP
#include "SMinternal.h"
#include "SMcompacting.h"
#include "SMextn.h"

REGDUMP(ScanRegDump);

compactingData compactingInfo = {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 */

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)");

	compactingInfo.bit_words
	  = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
	compactingInfo.bits
	  = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - compactingInfo.bit_words;

	compactingInfo.heap_words = RTSflags.GcFlags.heapSize - compactingInfo.bit_words;
	compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words);
	compactingInfo.lim  = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words);

	stat_init("COMPACTING", "", "");
    }

    sm->hp = hp_start = compactingInfo.base - 1;

    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
	sm->hplim = compactingInfo.lim;
    } else {
	sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;

	RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */

	if (sm->hplim > compactingInfo.lim) {
	    fprintf(stderr, "Not enough heap for requested alloc size\n");
	    return rtsFalse;
	}
    }

    sm->CAFlist = NULL;

#ifndef PAR
    initExtensions( sm );
#endif /* !PAR */

    if (RTSflags.GcFlags.trace) {
	fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n",
		(W_) compactingInfo.base, (W_) compactingInfo.lim,
		(W_) compactingInfo.bits, (W_) compactingInfo.bit_words);
	fprintf(stderr, "COMPACTING Initial: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
		(W_) compactingInfo.base,
		(W_) compactingInfo.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 */

    SAVE_REGS(&ScanRegDump); /* Save registers */

    if (RTSflags.GcFlags.trace) {
        fflush(stdout);     /* Flush stdout at start of GC */
	fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n                 hp 0x%lx, hplim 0x%lx, req %lu\n",
		(W_) compactingInfo.base, (W_) compactingInfo.lim,
		(W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_)));
      }

    alloc = sm->hp - hp_start;

    stat_startGC(alloc);

    /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAN_REG_MAP */
    RESTORE_REGS(&ScanRegDump);

    markHeapRoots(sm, sm->CAFlist, 0,
		  compactingInfo.base,
		  compactingInfo.lim,
		  compactingInfo.bits);

    SAVE_REGS(&ScanRegDump);
    /* end of bracket */

#ifndef PAR
    sweepUpDeadForeignObjs(sm->ForeignObjList, 
			   compactingInfo.base, 
			   compactingInfo.bits );
#endif

    LinkCAFs(sm->CAFlist);

    LinkRoots( sm->roots, sm->rootno );
#if defined(GRAN)
    LinkEvents();
#endif
#if defined(CONCURRENT)
    LinkSparks();
#endif
#ifdef PAR
    LinkLiveGAs(compactingInfo.base, compactingInfo.bits);
#else
    /*
      The stable pointer table is reachable via sm->roots,
      (Reason: in markHeapRoots all roots have to be considered,
      including the StablePointerTable)

    DEBUG_STRING("Linking Stable Pointer Table:");
    LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);

    */
    LinkAStack( MAIN_SpA, stackInfo.botA );
    LinkBStack( MAIN_SuB, stackInfo.botB );
#endif /* parallel */

    /* Do Inplace Compaction */
    /* Returns start of next closure, -1 gives last allocated word */

    sm->hp = Inplace_Compaction(compactingInfo.base,
				compactingInfo.lim,
				0, 0,
				compactingInfo.bits,
				compactingInfo.bit_words
#if ! defined(PAR)
				, &(sm->ForeignObjList)
#endif
				) - 1;

    resident = sm->hp - (compactingInfo.base - 1);
    DO_MAX_RESIDENCY(resident); /* stats only */

    if (! RTSflags.GcFlags.allocAreaSizeGiven) {
	sm->hplim = compactingInfo.lim;
	free_space = sm->hplim - sm->hp;
    } else {
	sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
	if (sm->hplim > compactingInfo.lim) {
	    free_space = 0;
	} else {
	    free_space = RTSflags.GcFlags.allocAreaSize;
	}
    }

    hp_start = sm->hp;

    stat_endGC(alloc, compactingInfo.heap_words, resident, "");

    if (RTSflags.GcFlags.trace)
	fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
		(W_) compactingInfo.base, (W_) compactingInfo.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(&ScanRegDump);     /* Restore Registers */

    if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
	return GC_HARD_LIMIT_EXCEEDED;	/* Heap exhausted */
    else 
	return GC_SUCCESS;		/* Heap OK */
}

#endif /* GC1s */

\end{code}