ghc/runtime/storage/SM1s.lc

   1 ***************************************************************************
   2
   3                       COMPACTING GARBAGE COLLECTION
   4
   5 Additional Global Data Requirements:
   6   ++ All the root locations are in malloced space (and info tables in
   7      static data space). This is to simplify the location list end test.
   8
   9 ***************************************************************************
  10
  11 [Someone needs to document this too. KH]
  12
  13 \begin{code}
  14 #if defined(GC1s)
  15
  16 ToDo:  Soft heap limits
  17
  18 #define  SCAN_REG_DUMP
  19 #include "SMinternal.h"
  20 #include "SMcompacting.h"
  21 #include "SMextn.h"
  22
  23 REGDUMP(ScanRegDump);
  24
  25 compactingData compactingInfo = {0, 0, 0, 0, 0};
  26
  27 P_ heap_space = 0;              /* Address of first word of slab
  28                                    of memory allocated for heap */
  29
  30 P_ hp_start;            /* Value of Hp when reduction was resumed */
  31
  32 rtsBool
  33 initHeap( smInfo *sm )
  34 {
  35     if (heap_space == 0) { /* allocates if it doesn't already exist */
  36
  37         /* Allocate the roots space */
  38         sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
  39
  40         /* Allocate the heap */
  41         heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
  42                                          "initHeap (heap)");
  43
  44         compactingInfo.bit_words
  45           = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
  46         compactingInfo.bits
  47           = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - compactingInfo.bit_words;
  48
  49         compactingInfo.heap_words = RTSflags.GcFlags.heapSize - compactingInfo.bit_words;
  50         compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words);
  51         compactingInfo.lim  = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words);
  52
  53         stat_init("COMPACTING", "", "");
  54     }
  55
  56     sm->hp = hp_start = compactingInfo.base - 1;
  57
  58     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
  59         sm->hplim = compactingInfo.lim;
  60     } else {
  61         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
  62
  63         RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
  64
  65         if (sm->hplim > compactingInfo.lim) {
  66             fprintf(stderr, "Not enough heap for requested alloc size\n");
  67             return rtsFalse;
  68         }
  69     }
  70
  71     sm->CAFlist = NULL;
  72
  73 #ifndef PAR
  74     initExtensions( sm );
  75 #endif /* !PAR */
  76
  77     if (RTSflags.GcFlags.trace) {
  78         fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n",
  79                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
  80                 (W_) compactingInfo.bits, (W_) compactingInfo.bit_words);
  81         fprintf(stderr, "COMPACTING Initial: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
  82                 (W_) compactingInfo.base,
  83                 (W_) compactingInfo.lim,
  84                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
  85     }
  86
  87     return rtsTrue; /* OK */
  88 }
  89
  90 I_
  91 collectHeap(reqsize, sm, do_full_collection)
  92     W_ reqsize;
  93     smInfo *sm;
  94     rtsBool do_full_collection; /* ignored */
  95 {
  96     I_ free_space,      /* No of words of free space following GC */
  97         alloc,          /* Number of words allocated since last GC */
  98         resident;       /* Number of words remaining after GC */
  99
 100     SAVE_REGS(&ScanRegDump); /* Save registers */
 101
 102     if (RTSflags.GcFlags.trace) {
 103         fflush(stdout);     /* Flush stdout at start of GC */
 104         fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n                 hp 0x%lx, hplim 0x%lx, req %lu\n",
 105                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
 106                 (W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_)));
 107       }
 108
 109     alloc = sm->hp - hp_start;
 110
 111     stat_startGC(alloc);
 112
 113     /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAN_REG_MAP */
 114     RESTORE_REGS(&ScanRegDump);
 115
 116     markHeapRoots(sm, sm->CAFlist, 0,
 117                   compactingInfo.base,
 118                   compactingInfo.lim,
 119                   compactingInfo.bits);
 120
 121     SAVE_REGS(&ScanRegDump);
 122     /* end of bracket */
 123
 124 #ifndef PAR
 125     sweepUpDeadMallocPtrs(sm->MallocPtrList,
 126                           compactingInfo.base,
 127                           compactingInfo.bits );
 128 #endif
 129
 130     LinkCAFs(sm->CAFlist);
 131
 132     LinkRoots( sm->roots, sm->rootno );
 133 #ifdef CONCURRENT
 134     LinkSparks();
 135 #endif
 136 #ifdef PAR
 137     LinkLiveGAs(compactingInfo.base, compactingInfo.bits);
 138 #else
 139     DEBUG_STRING("Linking Stable Pointer Table:");
 140     LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
 141     LinkAStack( MAIN_SpA, stackInfo.botA );
 142     LinkBStack( MAIN_SuB, stackInfo.botB );
 143 #endif /* parallel */
 144
 145     /* Do Inplace Compaction */
 146     /* Returns start of next closure, -1 gives last allocated word */
 147
 148     sm->hp = Inplace_Compaction(compactingInfo.base,
 149                                 compactingInfo.lim,
 150                                 0, 0,
 151                                 compactingInfo.bits,
 152                                 compactingInfo.bit_words
 153 #if ! defined(PAR)
 154                                 , &(sm->MallocPtrList)
 155 #endif
 156                                 ) - 1;
 157
 158     resident = sm->hp - (compactingInfo.base - 1);
 159     DO_MAX_RESIDENCY(resident); /* stats only */
 160
 161     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
 162         sm->hplim = compactingInfo.lim;
 163         free_space = sm->hplim - sm->hp;
 164     } else {
 165         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
 166         if (sm->hplim > compactingInfo.lim) {
 167             free_space = 0;
 168         } else {
 169             free_space = RTSflags.GcFlags.allocAreaSize;
 170         }
 171     }
 172
 173     hp_start = sm->hp;
 174
 175     stat_endGC(alloc, compactingInfo.heap_words, resident, "");
 176
 177     if (RTSflags.GcFlags.trace)
 178         fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
 179                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
 180                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
 181
 182 #ifdef DEBUG
 183     /* To help flush out bugs, we trash the part of the heap from
 184        which we're about to start allocating. */
 185     TrashMem(sm->hp+1, sm->hplim);
 186 #endif /* DEBUG */
 187
 188     RESTORE_REGS(&ScanRegDump);     /* Restore Registers */
 189
 190     if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
 191         return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
 192     else
 193         return GC_SUCCESS;              /* Heap OK */
 194 }
 195
 196 #endif /* GC1s */
 197
 198 \end{code}
 199