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     sweepUpDeadForeignObjs(sm->ForeignObjList,
 126                            compactingInfo.base,
 127                            compactingInfo.bits );
 128 #endif
 129
 130     LinkCAFs(sm->CAFlist);
 131
 132     LinkRoots( sm->roots, sm->rootno );
 133 #if defined(GRAN)
 134     LinkEvents();
 135 #endif
 136 #if defined(CONCURRENT) /* && !defined(GRAN) */
 137     LinkSparks();
 138 #endif
 139 #ifdef PAR
 140     LinkLiveGAs(compactingInfo.base, compactingInfo.bits);
 141 #else
 142     /*
 143       The stable pointer table is reachable via sm->roots,
 144       (Reason: in markHeapRoots all roots have to be considered,
 145       including the StablePointerTable)
 146
 147     DEBUG_STRING("Linking Stable Pointer Table:");
 148     LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
 149
 150     */
 151 # if /* !defined(GRAN) */  /* HWL */
 152     LinkAStack( MAIN_SpA, stackInfo.botA );
 153     LinkBStack( MAIN_SuB, stackInfo.botB );
 154 # endif
 155 #endif /* parallel */
 156
 157     /* Do Inplace Compaction */
 158     /* Returns start of next closure, -1 gives last allocated word */
 159
 160     sm->hp = Inplace_Compaction(compactingInfo.base,
 161                                 compactingInfo.lim,
 162                                 0, 0,
 163                                 compactingInfo.bits,
 164                                 compactingInfo.bit_words
 165 #if ! defined(PAR)
 166                                 , &(sm->ForeignObjList)
 167 #endif
 168                                 ) - 1;
 169
 170     resident = sm->hp - (compactingInfo.base - 1);
 171     DO_MAX_RESIDENCY(resident); /* stats only */
 172
 173     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
 174         sm->hplim = compactingInfo.lim;
 175         free_space = sm->hplim - sm->hp;
 176     } else {
 177         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
 178         if (sm->hplim > compactingInfo.lim) {
 179             free_space = 0;
 180         } else {
 181             free_space = RTSflags.GcFlags.allocAreaSize;
 182         }
 183     }
 184
 185     hp_start = sm->hp;
 186
 187     stat_endGC(alloc, compactingInfo.heap_words, resident, "");
 188
 189     if (RTSflags.GcFlags.trace)
 190         fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
 191                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
 192                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
 193
 194 #ifdef DEBUG
 195     /* To help flush out bugs, we trash the part of the heap from
 196        which we're about to start allocating. */
 197     TrashMem(sm->hp+1, sm->hplim);
 198 #endif /* DEBUG */
 199
 200     RESTORE_REGS(&ScanRegDump);     /* Restore Registers */
 201
 202     if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
 203         return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
 204     else
 205         return GC_SUCCESS;              /* Heap OK */
 206 }
 207
 208 #endif /* GC1s */
 209
 210 \end{code}
 211