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 I_
  33 initHeap( sm )
  34     smInfo *sm;
  35 {
  36     if (heap_space == 0) { /* allocates if it doesn't already exist */
  37
  38         /* Allocate the roots space */
  39         sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) );
  40
  41         /* Allocate the heap */
  42         heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_));
  43
  44         compactingInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
  45         compactingInfo.bits      = (BitWord *)(heap_space + SM_word_heap_size) - compactingInfo.bit_words;
  46
  47         compactingInfo.heap_words =  SM_word_heap_size - compactingInfo.bit_words;
  48         compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words);
  49         compactingInfo.lim  = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words);
  50
  51         stat_init("COMPACTING", "", "");
  52     }
  53
  54     sm->hp = hp_start = compactingInfo.base - 1;
  55
  56     if (SM_alloc_size) {
  57         sm->hplim = sm->hp + SM_alloc_size;
  58         SM_alloc_min = 0; /* No min; alloc size specified */
  59
  60         if (sm->hplim > compactingInfo.lim) {
  61             fprintf(stderr, "Not enough heap for requested alloc size\n");
  62             return -1;
  63         }
  64     } else {
  65         sm->hplim = compactingInfo.lim;
  66     }
  67
  68     sm->CAFlist = NULL;
  69
  70 #ifndef PAR
  71     initExtensions( sm );
  72 #endif /* !PAR */
  73
  74     if (SM_trace) {
  75         fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n",
  76                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
  77                 (W_) compactingInfo.bits, (W_) compactingInfo.bit_words);
  78         fprintf(stderr, "COMPACTING Initial: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
  79                 (W_) compactingInfo.base,
  80                 (W_) compactingInfo.lim,
  81                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
  82     }
  83
  84     return 0;
  85 }
  86
  87 I_
  88 collectHeap(reqsize, sm, do_full_collection)
  89     W_ reqsize;
  90     smInfo *sm;
  91     rtsBool do_full_collection; /* ignored */
  92 {
  93     I_ free_space,      /* No of words of free space following GC */
  94         alloc,          /* Number of words allocated since last GC */
  95         resident;       /* Number of words remaining after GC */
  96
  97     SAVE_REGS(&ScanRegDump); /* Save registers */
  98
  99     if (SM_trace)
 100       {
 101         fflush(stdout);     /* Flush stdout at start of GC */
 102         fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n                 hp 0x%lx, hplim 0x%lx, req %lu\n",
 103                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
 104                 (W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_)));
 105       }
 106
 107     alloc = sm->hp - hp_start;
 108
 109     stat_startGC(alloc);
 110
 111     /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAN_REG_MAP */
 112     RESTORE_REGS(&ScanRegDump);
 113
 114     markHeapRoots(sm, sm->CAFlist, 0,
 115                   compactingInfo.base,
 116                   compactingInfo.lim,
 117                   compactingInfo.bits);
 118
 119     SAVE_REGS(&ScanRegDump);
 120     /* end of bracket */
 121
 122 #ifndef PAR
 123     sweepUpDeadMallocPtrs(sm->MallocPtrList,
 124                           compactingInfo.base,
 125                           compactingInfo.bits );
 126 #endif
 127
 128     LinkCAFs(sm->CAFlist);
 129
 130     LinkRoots( sm->roots, sm->rootno );
 131 #ifdef CONCURRENT
 132     LinkSparks();
 133 #endif
 134 #ifdef PAR
 135     LinkLiveGAs(compactingInfo.base, compactingInfo.bits);
 136 #else
 137     DEBUG_STRING("Linking Stable Pointer Table:");
 138     LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
 139     LinkAStack( MAIN_SpA, stackInfo.botA );
 140     LinkBStack( MAIN_SuB, stackInfo.botB );
 141 #endif /* parallel */
 142
 143     /* Do Inplace Compaction */
 144     /* Returns start of next closure, -1 gives last allocated word */
 145
 146     sm->hp = Inplace_Compaction(compactingInfo.base,
 147                                 compactingInfo.lim,
 148                                 0, 0,
 149                                 compactingInfo.bits,
 150                                 compactingInfo.bit_words
 151 #if ! defined(PAR)
 152                                 , &(sm->MallocPtrList)
 153 #endif
 154                                 ) - 1;
 155
 156     resident = sm->hp - (compactingInfo.base - 1);
 157     DO_MAX_RESIDENCY(resident); /* stats only */
 158
 159     if (SM_alloc_size) {
 160         sm->hplim = sm->hp + SM_alloc_size;
 161         if (sm->hplim > compactingInfo.lim) {
 162             free_space = 0;
 163         } else {
 164             free_space = SM_alloc_size;
 165         }
 166     } else {
 167         sm->hplim = compactingInfo.lim;
 168         free_space = sm->hplim - sm->hp;
 169     }
 170
 171     hp_start = sm->hp;
 172
 173     stat_endGC(alloc, compactingInfo.heap_words, resident, "");
 174
 175     if (SM_trace)
 176         fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n                    hp 0x%lx, hplim 0x%lx, free %lu\n",
 177                 (W_) compactingInfo.base, (W_) compactingInfo.lim,
 178                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
 179
 180 #ifdef DEBUG
 181     /* To help flush out bugs, we trash the part of the heap from
 182        which we're about to start allocating. */
 183     TrashMem(sm->hp+1, sm->hplim);
 184 #endif /* DEBUG */
 185
 186     RESTORE_REGS(&ScanRegDump);     /* Restore Registers */
 187
 188     if ((SM_alloc_min > free_space) || (reqsize > free_space))
 189         return GC_HARD_LIMIT_EXCEEDED;  /* Heap exhausted */
 190     else
 191         return GC_SUCCESS;              /* Heap OK */
 192 }
 193
 194 #endif /* GC1s */
 195
 196 \end{code}
 197