ghc/runtime/storage/SM2s.lc

   1 ***************************************************************************
   2
   3                            TWO SPACE COLLECTION
   4
   5 ***************************************************************************
   6
   7 \begin{code}
   8 #if defined(GC2s)
   9
  10 #define SCAV_REG_MAP
  11 #include "SMinternal.h"
  12 #include "SMcopying.h"
  13 #include "SMextn.h"
  14
  15 REGDUMP(ScavRegDump);
  16
  17 I_ semispace = 0;              /* 0 or 1 */
  18 semispaceData semispaceInfo[2]
  19     = {{0,0}, {0,0}};
  20
  21 P_ heap_space = 0;              /* Address of first word of slab
  22                                    of memory allocated for heap */
  23
  24 P_ hp_start;            /* Value of Hp when reduction was resumed */
  25
  26
  27 rtsBool
  28 initHeap(smInfo * sm)
  29 {
  30     if (heap_space == 0) { /* allocates if it doesn't already exist */
  31
  32         I_ semispaceSize = RTSflags.GcFlags.heapSize / 2;
  33
  34         /* Allocate the roots space */
  35         sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
  36
  37         /* Allocate the heap */
  38         heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
  39                                          "initHeap (heap)");
  40
  41         /* Define the semi-spaces */
  42         semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize);
  43         semispaceInfo[1].base = HEAP_FRAME_BASE(heap_space + semispaceSize, semispaceSize);
  44         semispaceInfo[0].lim = HEAP_FRAME_LIMIT(heap_space, semispaceSize);
  45         semispaceInfo[1].lim = HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize);
  46
  47         stat_init("TWOSPACE",
  48                   " No of Roots  Caf   Caf    Astk   Bstk",
  49                   "Astk Bstk Reg  No  bytes  bytes  bytes");
  50     }
  51
  52     /* Initialise heap pointer and limit */
  53     sm->hp = hp_start = semispaceInfo[semispace].base - 1;
  54     sm->hardHpOverflowSize = 0;
  55
  56     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
  57         sm->hplim = semispaceInfo[semispace].lim;
  58     } else {
  59         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
  60
  61         RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
  62
  63         if (sm->hplim > semispaceInfo[semispace].lim) {
  64             fprintf(stderr, "Not enough heap for requested alloc size\n");
  65             return rtsFalse;
  66         }
  67     }
  68
  69     if (RTSflags.GcFlags.forceGC) {
  70        if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
  71           sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
  72        } else {
  73           RTSflags.GcFlags.forceGC = rtsFalse;
  74           /* forcing GC has no effect, as semi-space is smaller than forcingInterval */
  75        }
  76     }
  77
  78     sm->CAFlist = NULL;
  79
  80 #ifndef PAR
  81     initExtensions( sm );
  82 #endif /* !PAR */
  83
  84     if (RTSflags.GcFlags.trace) {
  85         fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n                0x%lx, 0x%lx, 0x%lx, 0x%lx\n",
  86                 (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim,
  87                 (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim);
  88         fprintf(stderr, "TWO SPACE Initial: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
  89                 semispace,
  90                 (W_) semispaceInfo[semispace].base,
  91                 (W_) semispaceInfo[semispace].lim,
  92                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
  93     }
  94
  95     return rtsTrue; /* OK */
  96 }
  97
  98 I_
  99 collectHeap(reqsize, sm, do_full_collection)
 100     W_ reqsize;
 101     smInfo *sm;
 102     rtsBool do_full_collection; /* ignored */
 103 {
 104     I_ free_space,      /* No of words of free space following GC */
 105         alloc,          /* Number of words allocated since last GC */
 106         resident,       /* Number of words remaining after GC */
 107         extra_caf_words,/* Extra words referenced from CAFs */
 108         caf_roots,      /* Number of CAFs */
 109         bstk_roots;     /* Number of update frames on B stack */
 110
 111     fflush(stdout);     /* Flush stdout at start of GC */
 112     SAVE_REGS(&ScavRegDump); /* Save registers */
 113
 114 #if defined(PROFILING)
 115     if (interval_expired) { heap_profile_setup(); }
 116 #endif  /* PROFILING */
 117
 118     if (RTSflags.GcFlags.trace)
 119         fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, req %lu\n",
 120                 semispace, (W_) semispaceInfo[semispace].base,
 121                 (W_) semispaceInfo[semispace].lim,
 122                 (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
 123
 124     alloc = sm->hp - hp_start;
 125     stat_startGC(alloc);
 126
 127     /* Set Up For Collecting:
 128          - Flip Spaces
 129          - Set ToHp to point one below bottom of to-space (last allocated)
 130          - Set CAFs to Evac & Upd
 131      */
 132
 133     semispace = NEXT_SEMI_SPACE(semispace);
 134     ToHp = semispaceInfo[semispace].base - 1;
 135     Scav = semispaceInfo[semispace].base;
 136
 137     SetCAFInfoTables( sm->CAFlist );
 138 #ifdef PAR
 139     EvacuateLocalGAs(rtsTrue);
 140 #else
 141     /* evacSPTable( sm ); stable pointers now reachable via sm->roots */
 142 #endif /* PAR */
 143     EvacuateRoots( sm->roots, sm->rootno );
 144 #if defined(GRAN)
 145     EvacuateEvents();
 146 #endif
 147 #if defined(CONCURRENT)
 148     EvacuateSparks();
 149 #endif
 150 #if !defined(PAR) /* && !defined(GRAN) */
 151     EvacuateAStack( MAIN_SpA, stackInfo.botA );
 152     EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
 153 #endif /* !PAR */
 154
 155     Scavenge();
 156
 157     EvacAndScavengeCAFs( sm->CAFlist, &extra_caf_words, &caf_roots );
 158
 159 #ifdef PAR
 160     RebuildGAtables(rtsTrue);
 161 #else
 162     reportDeadForeignObjs(sm->ForeignObjList, NULL, &(sm->ForeignObjList) );
 163 #endif /* PAR */
 164
 165     /* TIDY UP AND RETURN */
 166
 167     sm->hp = hp_start = ToHp;  /* Last allocated word */
 168
 169     resident = sm->hp - (semispaceInfo[semispace].base - 1);
 170     DO_MAX_RESIDENCY(resident); /* stats only */
 171
 172     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
 173         sm->hplim = semispaceInfo[semispace].lim;
 174         free_space = sm->hplim - sm->hp;
 175     } else {
 176         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
 177         if (sm->hplim > semispaceInfo[semispace].lim) {
 178             free_space = 0;
 179         } else {
 180             free_space = RTSflags.GcFlags.allocAreaSize;
 181         }
 182     }
 183
 184     if (RTSflags.GcFlags.giveStats) {
 185         char comment_str[BIG_STRING_LEN];
 186 #ifndef PAR
 187         sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
 188                 (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 189                 bstk_roots, sm->rootno,
 190                 caf_roots, extra_caf_words*sizeof(W_),
 191                 (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
 192                 (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_));
 193 #else
 194         /* ToDo: come up with some interesting statistics for the parallel world */
 195         sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu",
 196                 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0);
 197 #endif
 198
 199 #if defined(PROFILING)
 200         if (interval_expired) { strcat(comment_str, " prof"); }
 201 #endif
 202
 203         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
 204     } else {
 205         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
 206     }
 207
 208 #if defined(PROFILING) || defined(PAR)
 209       if (interval_expired) {
 210 #if defined(PROFILING)
 211           heap_profile_done();
 212 #endif
 213           report_cc_profiling(0 /*partial*/);
 214       }
 215 #endif /* PROFILING */
 216
 217     if (RTSflags.GcFlags.trace)
 218         fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n                         hp 0x%lx, hplim 0x%lx, free %lu\n",
 219                 semispace, (W_) semispaceInfo[semispace].base,
 220                 (W_) semispaceInfo[semispace].lim,
 221                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
 222
 223 #ifdef DEBUG
 224     /* To help flush out bugs, we trash the part of the heap from
 225        which we're about to start allocating and all of the other semispace. */
 226     TrashMem(sm->hp+1, sm->hplim);
 227     TrashMem(semispaceInfo[NEXT_SEMI_SPACE(semispace)].base,
 228              semispaceInfo[NEXT_SEMI_SPACE(semispace)].lim);
 229 #endif /* DEBUG */
 230
 231     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 232
 233     if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_sapce < reqsize)
 234       return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
 235
 236     else {
 237         if (RTSflags.GcFlags.forceGC
 238          && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 239               sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 240         }
 241
 242         if (reqsize + sm->hardHpOverflowSize > free_space) {
 243             return( GC_SOFT_LIMIT_EXCEEDED );   /* Heap nearly exhausted */
 244         } else {
 245             return( GC_SUCCESS );                   /* Heap OK */
 246         }
 247     }
 248 }
 249
 250 #endif /* GC2s */
 251 \end{code}