diff options
Diffstat (limited to 'ghc/runtime/storage/SM1s.lc')
| -rw-r--r-- | ghc/runtime/storage/SM1s.lc | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/ghc/runtime/storage/SM1s.lc b/ghc/runtime/storage/SM1s.lc new file mode 100644 index 0000000000..51265e5959 --- /dev/null +++ b/ghc/runtime/storage/SM1s.lc @@ -0,0 +1,197 @@ +*************************************************************************** + + 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 */ + +I_ +initHeap( sm ) + smInfo *sm; +{ + 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_)); + + compactingInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); + compactingInfo.bits = (BitWord *)(heap_space + SM_word_heap_size) - compactingInfo.bit_words; + + compactingInfo.heap_words = SM_word_heap_size - 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 (SM_alloc_size) { + sm->hplim = sm->hp + SM_alloc_size; + SM_alloc_min = 0; /* No min; alloc size specified */ + + if (sm->hplim > compactingInfo.lim) { + fprintf(stderr, "Not enough heap for requested alloc size\n"); + return -1; + } + } else { + sm->hplim = compactingInfo.lim; + } + + sm->CAFlist = NULL; + +#ifndef PAR + initExtensions( sm ); +#endif /* !PAR */ + + if (SM_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 0; +} + +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 (SM_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 + sweepUpDeadMallocPtrs(sm->MallocPtrList, + compactingInfo.base, + compactingInfo.bits ); +#endif + + LinkCAFs(sm->CAFlist); + + LinkRoots( sm->roots, sm->rootno ); +#ifdef CONCURRENT + LinkSparks(); +#endif +#ifdef PAR + LinkLiveGAs(compactingInfo.base, compactingInfo.bits); +#else + 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->MallocPtrList) +#endif + ) - 1; + + resident = sm->hp - (compactingInfo.base - 1); + DO_MAX_RESIDENCY(resident); /* stats only */ + + if (SM_alloc_size) { + sm->hplim = sm->hp + SM_alloc_size; + if (sm->hplim > compactingInfo.lim) { + free_space = 0; + } else { + free_space = SM_alloc_size; + } + } else { + sm->hplim = compactingInfo.lim; + free_space = sm->hplim - sm->hp; + } + + hp_start = sm->hp; + + stat_endGC(alloc, compactingInfo.heap_words, resident, ""); + + if (SM_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 ((SM_alloc_min > free_space) || (reqsize > free_space)) + return GC_HARD_LIMIT_EXCEEDED; /* Heap exhausted */ + else + return GC_SUCCESS; /* Heap OK */ +} + +#endif /* GC1s */ + +\end{code} + |