ghc/runtime/storage/SMap.lc

   1 ***************************************************************************
   2
   3                       APPEL'S GARBAGE COLLECTION
   4
   5 Global heap requirements as for 1s and 2s collectors.
   6     ++ All closures in the old generation that are updated must be
   7        updated with indirections and placed on the linked list of
   8        updated old generation closures.
   9
  10 ***************************************************************************
  11
  12 \begin{code}
  13 #if defined(GCap)
  14
  15 #define  SCAV_REG_MAP
  16 #include "SMinternal.h"
  17 #include "SMcopying.h"
  18 #include "SMcompacting.h"
  19 #include "SMextn.h"
  20
  21 REGDUMP(ScavRegDump);
  22
  23 appelData appelInfo = {0, 0, 0, 0, 0,
  24                        0, 0, 0, 0, 0, 0, 0, 0, 0,
  25                        0, {{0, 0}, {0, 0}}
  26                       };
  27
  28 P_ heap_space = 0;              /* Address of first word of slab
  29                                    of memory allocated for heap */
  30
  31 P_ hp_start;            /* Value of Hp when reduction was resumed */
  32
  33 static I_ allocd_since_last_major_GC = 0;
  34         /* words alloced since last major GC; used when forcing GC */
  35
  36 #if defined(DEBUG)
  37 void
  38 debug_look_for (start, stop, villain)
  39   P_ start, stop, villain;
  40 {
  41     P_ i;
  42     for (i = start; i <= stop; i++) {
  43         if ( (P_) *i == villain ) {
  44             fprintf(stderr, "* %x : %x\n", i, villain);
  45         }
  46     }
  47 }
  48 #endif
  49
  50 rtsBool
  51 initHeap(smInfo * sm)
  52 {
  53     if (heap_space == 0) { /* allocates if it doesn't already exist */
  54
  55         /* Allocate the roots space */
  56         sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)");
  57
  58         /* Allocate the heap */
  59         heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS,
  60                                          "initHeap (heap)");
  61
  62         /* ToDo (ADR): trash entire heap contents */
  63
  64         if (RTSflags.GcFlags.force2s) {
  65             stat_init("TWOSPACE(APPEL)",
  66                       " No of Roots  Caf   Caf    Astk   Bstk",
  67                       "Astk Bstk Reg  No  bytes  bytes  bytes");
  68         } else {
  69             stat_init("APPEL",
  70                       " No of Roots  Caf  Mut-  Old  Collec  Resid",
  71                       "Astk Bstk Reg  No  able  Gen   tion   %heap");
  72         }
  73     }
  74     sm->hardHpOverflowSize = 0;
  75
  76     if (RTSflags.GcFlags.force2s) {
  77         I_ semi_space_words = RTSflags.GcFlags.heapSize / 2;
  78         appelInfo.space[0].base = HEAP_FRAME_BASE(heap_space, semi_space_words);
  79         appelInfo.space[1].base = HEAP_FRAME_BASE(heap_space + semi_space_words, semi_space_words);
  80         appelInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, semi_space_words);
  81         appelInfo.space[1].lim = HEAP_FRAME_LIMIT(heap_space + semi_space_words, semi_space_words);
  82         appelInfo.semi_space = 0;
  83         appelInfo.oldlim = heap_space - 1;  /* Never in old generation */
  84
  85         sm->hp = hp_start = appelInfo.space[appelInfo.semi_space].base - 1;
  86
  87         if (! RTSflags.GcFlags.allocAreaSizeGiven) {
  88             sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
  89         } else {
  90             sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
  91
  92             RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */
  93
  94             if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
  95                 fprintf(stderr, "Not enough heap for requested alloc size\n");
  96                 return rtsFalse;
  97             }
  98         }
  99
 100         if (RTSflags.GcFlags.forceGC) {
 101            if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 102               sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 103            } else {
 104               /* no point in forcing GC,
 105                  as the semi-space is smaller than forcingInterval */
 106               RTSflags.GcFlags.forceGC = rtsFalse;
 107            }
 108         }
 109
 110         sm->OldLim = appelInfo.oldlim;
 111         sm->CAFlist = NULL;
 112
 113 #ifndef PAR
 114         initExtensions( sm );
 115 #endif
 116
 117         if (RTSflags.GcFlags.trace) {
 118             fprintf(stderr, "APPEL(2s) Heap: 0x%lx .. 0x%lx\n",
 119                     (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
 120             fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n         hp 0x%lx, hplim 0x%lx, free %lu\n",
 121                     appelInfo.semi_space,
 122                     (W_) appelInfo.space[appelInfo.semi_space].base,
 123                     (W_) appelInfo.space[appelInfo.semi_space].lim,
 124                     (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
 125         }
 126         return rtsTrue;
 127     }
 128
 129
 130 /* So not forced 2s */
 131
 132     appelInfo.newlim  = heap_space + RTSflags.GcFlags.heapSize - 1;
 133     if (RTSflags.GcFlags.allocAreaSizeGiven) {
 134         appelInfo.newfixed = RTSflags.GcFlags.allocAreaSize;
 135         appelInfo.newmin   = RTSflags.GcFlags.allocAreaSize;
 136         appelInfo.newbase  = heap_space + RTSflags.GcFlags.heapSize - appelInfo.newfixed;
 137     } else {
 138         appelInfo.newfixed = 0;
 139         appelInfo.newmin   = RTSflags.GcFlags.minAllocAreaSize;
 140         appelInfo.newbase  = heap_space + (RTSflags.GcFlags.heapSize / 2);
 141     }
 142
 143     appelInfo.oldbase = heap_space;
 144     appelInfo.oldlim  = heap_space - 1;
 145     appelInfo.oldlast = heap_space - 1;
 146     appelInfo.oldmax  = heap_space - 1 + RTSflags.GcFlags.heapSize - 2*appelInfo.newmin;
 147
 148     if (appelInfo.oldbase > appelInfo.oldmax) {
 149         fprintf(stderr, "Not enough heap for requested/minimum allocation area\n");
 150         fprintf(stderr, "heap_space=%ld\n", (W_) heap_space);
 151         fprintf(stderr, "heapSize=%ld\n", RTSflags.GcFlags.heapSize);
 152         fprintf(stderr, "newmin=%ld\n", appelInfo.newmin);
 153         return rtsFalse;
 154     }
 155
 156     appelInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
 157     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
 158
 159     if (appelInfo.bit_words > appelInfo.newmin)
 160         appelInfo.oldmax = heap_space - 1 + RTSflags.GcFlags.heapSize - appelInfo.bit_words - appelInfo.newmin;
 161
 162     if (RTSflags.GcFlags.specifiedOldGenSize) {
 163         appelInfo.oldthresh = heap_space -1 + RTSflags.GcFlags.specifiedOldGenSize;
 164         if (appelInfo.oldthresh > appelInfo.oldmax) {
 165             fprintf(stderr, "Not enough heap for requested major resid size\n");
 166             return rtsFalse;
 167         }
 168     } else {
 169         appelInfo.oldthresh = heap_space + RTSflags.GcFlags.heapSize * 2 / 3; /* Initial threshold -- 2/3rds */
 170         if (appelInfo.oldthresh > appelInfo.oldmax)
 171             appelInfo.oldthresh = appelInfo.oldmax;
 172     }
 173
 174     sm->hp = hp_start = appelInfo.newbase - 1;
 175     sm->hplim = appelInfo.newlim;
 176
 177     if (RTSflags.GcFlags.forceGC
 178      && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 179         sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 180     }
 181
 182     sm->OldLim = appelInfo.oldlim;
 183
 184     sm->CAFlist = NULL;
 185     appelInfo.OldCAFlist = NULL;
 186     appelInfo.OldCAFno = 0;
 187
 188 #ifndef PAR
 189     initExtensions( sm );
 190 #endif
 191
 192     appelInfo.PromMutables = 0;
 193
 194     if (RTSflags.GcFlags.trace) {
 195         fprintf(stderr, "APPEL Heap: 0x%lx .. 0x%lx\n",
 196                 (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize));
 197         fprintf(stderr, "Initial: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n         hp 0x%lx, hplim 0x%lx\n",
 198                 (W_) appelInfo.newbase, (W_) appelInfo.newlim,
 199                 (W_) appelInfo.oldbase, (W_) appelInfo.oldlim,
 200                 (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
 201                 (W_) sm->hp, (W_) sm->hplim);
 202     }
 203
 204     return rtsTrue; /* OK */
 205 }
 206
 207 static I_
 208 collect2s(W_ reqsize, smInfo *sm)
 209 {
 210     I_ free_space,      /* No of words of free space following GC */
 211         alloc,          /* Number of words allocated since last GC */
 212         resident,       /* Number of words remaining after GC */
 213         extra_caf_words,/* Extra words referenced from CAFs */
 214         caf_roots,      /* Number of CAFs */
 215         bstk_roots;     /* Number of update frames in B stack */
 216
 217     SAVE_REGS(&ScavRegDump);        /* Save registers */
 218
 219 #if defined(PROFILING)
 220     if (interval_expired) { heap_profile_setup(); }
 221 #endif  /* PROFILING */
 222
 223     if (RTSflags.GcFlags.trace)
 224         fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, req %lu\n",
 225                 appelInfo.semi_space,
 226                 (W_) appelInfo.space[appelInfo.semi_space].base,
 227                 (W_) appelInfo.space[appelInfo.semi_space].lim,
 228                 (W_) sm->hp, (W_) sm->hplim, (W_) (reqsize * sizeof(W_)));
 229
 230     alloc = sm->hp - hp_start;
 231     stat_startGC(alloc);
 232
 233     appelInfo.semi_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
 234     ToHp = appelInfo.space[appelInfo.semi_space].base - 1;
 235     Scav = appelInfo.space[appelInfo.semi_space].base;
 236     OldGen = sm->OldLim; /* always evac ! */
 237
 238     SetCAFInfoTables( sm->CAFlist );
 239 #ifdef PAR
 240     EvacuateLocalGAs(rtsTrue);
 241 #else
 242     /* evacSPTable( sm ); StablePointerTable now accessable in sm->roots SOF 4/96 */
 243 #endif /* PAR */
 244     EvacuateRoots( sm->roots, sm->rootno );
 245 #if defined(GRAN)
 246     EvacuateEvents();
 247 #endif
 248 #if defined(CONCURRENT)  /* && !defined(GRAN) */
 249     EvacuateSparks();
 250 #endif
 251 #if !defined(PAR) /* && !defined(GRAN) */  /* HWL */
 252     EvacuateAStack( MAIN_SpA, stackInfo.botA );
 253     EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
 254 #endif /* !PAR */
 255
 256     Scavenge();
 257
 258     EvacAndScavengeCAFs( sm->CAFlist, &extra_caf_words, &caf_roots );
 259
 260 #ifdef PAR
 261     RebuildGAtables(rtsTrue);
 262 #else
 263     reportDeadForeignObjs( sm->ForeignObjList, NULL, &(sm->ForeignObjList) );
 264 #endif /* PAR */
 265
 266     /* TIDY UP AND RETURN */
 267
 268     sm->hp = hp_start = ToHp;  /* Last allocated word */
 269
 270     resident = sm->hp - (appelInfo.space[appelInfo.semi_space].base - 1);
 271     DO_MAX_RESIDENCY(resident); /* stats only */
 272
 273     if (! RTSflags.GcFlags.allocAreaSizeGiven) {
 274         sm->hplim = appelInfo.space[appelInfo.semi_space].lim;
 275         free_space = sm->hplim - sm->hp;
 276     } else {
 277         sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize;
 278         if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) {
 279             free_space = 0;
 280         } else {
 281             free_space = RTSflags.GcFlags.allocAreaSize;
 282         }
 283     }
 284
 285     if (RTSflags.GcFlags.forceGC
 286      && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 287         sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 288     }
 289
 290     if (RTSflags.GcFlags.giveStats) {
 291         char comment_str[BIG_STRING_LEN];
 292 #if !defined(PAR) /* && !defined(CONCURRENT) */  /* HWL */
 293         sprintf(comment_str, "%4lu %4ld %3ld %3ld %6lu %6lu %6lu  2s",
 294                 (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 295                 bstk_roots, sm->rootno,
 296                 caf_roots, extra_caf_words*sizeof(W_),
 297                 (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_),
 298                 (W_) (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_));
 299 #else
 300         /* ToDo: come up with some interesting statistics for the parallel world */
 301         sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu  2s",
 302                 0, 0L, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0L, 0L);
 303
 304 #endif
 305
 306 #if defined(PROFILING)
 307         if (interval_expired) { strcat(comment_str, " prof"); }
 308 #endif
 309
 310         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str);
 311     } else {
 312         stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, "");
 313     }
 314
 315 #if defined(PROFILING) || defined(PAR)
 316       if (interval_expired) {
 317 # if defined(PROFILING)
 318           heap_profile_done();
 319 # endif
 320           report_cc_profiling(0 /*partial*/);
 321       }
 322 #endif /* PROFILING */
 323
 324     if (RTSflags.GcFlags.trace)
 325         fprintf(stderr, "Done:  space %ld, base 0x%lx, lim 0x%lx\n       hp 0x%lx, hplim 0x%lx, free %lu\n",
 326                 appelInfo.semi_space,
 327                 (W_) appelInfo.space[appelInfo.semi_space].base,
 328                 (W_) appelInfo.space[appelInfo.semi_space].lim,
 329                 (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_)));
 330
 331 #ifdef DEBUG
 332         /* To help flush out bugs, we trash the part of the heap from
 333            which we're about to start allocating, and all of the space
 334            we just came from. */
 335     {
 336       I_ old_space = NEXT_SEMI_SPACE(appelInfo.semi_space);
 337
 338       TrashMem(appelInfo.space[old_space].base, appelInfo.space[old_space].lim);
 339       TrashMem(sm->hp+1, sm->hplim);
 340     }
 341 #endif /* DEBUG */
 342
 343     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 344
 345     if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize)
 346       return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
 347     else {
 348         if (reqsize + sm->hardHpOverflowSize > free_space) {
 349           return( GC_SOFT_LIMIT_EXCEEDED );     /* Heap nearly exhausted */
 350         } else {
 351           return( GC_SUCCESS );          /* Heap OK */
 352         }
 353     }
 354 }
 355
 356
 357 I_
 358 collectHeap(reqsize, sm, do_full_collection)
 359     W_ reqsize;
 360     smInfo *sm;
 361     rtsBool do_full_collection; /* do a major collection regardless? */
 362 {
 363     I_ bstk_roots, caf_roots, mutable, old_words;
 364     P_ old_start, mutptr, prevmut;
 365     P_ CAFptr, prevCAF;
 366
 367     I_ alloc,           /* Number of words allocated since last GC */
 368         resident;       /* Number of words remaining after GC */
 369
 370     fflush(stdout);     /* Flush stdout at start of GC */
 371
 372     if (RTSflags.GcFlags.force2s) {
 373         return collect2s(reqsize, sm);
 374     }
 375
 376     SAVE_REGS(&ScavRegDump); /* Save registers */
 377
 378     if (RTSflags.GcFlags.trace)
 379         fprintf(stderr, "Start: newbase 0x%lx, newlim 0x%lx\n        hp 0x%lx, hplim 0x%lx, req %lu\n",
 380                 (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_));
 381
 382     alloc = sm->hp - hp_start;
 383     stat_startGC(alloc);
 384
 385     allocd_since_last_major_GC += sm->hplim - hp_start;
 386     /* this is indeed supposed to be less precise than alloc above */
 387
 388     /* COPYING COLLECTION */
 389
 390     /* Set ToHp to end of old gen */
 391     ToHp = appelInfo.oldlim;
 392
 393     /* Set OldGen register so we only evacuate new gen closures */
 394     OldGen = appelInfo.oldlim;
 395
 396     /* FIRST: Evacuate and Scavenge CAFs and roots in the old generation */
 397     old_start = ToHp;
 398
 399     SetCAFInfoTables( sm->CAFlist );
 400
 401     DEBUG_STRING("Evacuate CAFs:");
 402     caf_roots = 0;
 403     CAFptr = sm->CAFlist;
 404     prevCAF = ((P_)(&sm->CAFlist)) - FIXED_HS; /* see IND_CLOSURE_LINK */
 405     while (CAFptr) {
 406       EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
 407       caf_roots++;
 408       prevCAF = CAFptr;
 409       CAFptr = (P_) IND_CLOSURE_LINK(CAFptr);
 410     }
 411     IND_CLOSURE_LINK(prevCAF) = (W_) appelInfo.OldCAFlist;
 412     appelInfo.OldCAFlist = sm->CAFlist;
 413     appelInfo.OldCAFno += caf_roots;
 414     sm->CAFlist = NULL;
 415
 416     DEBUG_STRING("Evacuate Mutable Roots:");
 417     mutable = 0;
 418     mutptr = sm->OldMutables;
 419     /* Clever, but completely illegal: */
 420     prevmut = ((P_)&sm->OldMutables) - FIXED_HS;
 421                                 /* See MUT_LINK */
 422     while ( mutptr ) {
 423
 424         /* Scavenge the OldMutable */
 425         P_ info = (P_) INFO_PTR(mutptr);
 426         StgScavPtr scav_code = SCAV_CODE(info);
 427         Scav = mutptr;
 428         (scav_code)();
 429
 430         /* Remove from OldMutables if no longer mutable */
 431         if (!IS_MUTABLE(info)) {
 432             P_ tmp = mutptr;
 433             MUT_LINK(prevmut) = MUT_LINK(mutptr);
 434             mutptr = (P_) MUT_LINK(mutptr);
 435             MUT_LINK(tmp) = MUT_NOT_LINKED;
 436         } else {
 437             prevmut = mutptr;
 438             mutptr = (P_) MUT_LINK(mutptr);
 439         }
 440
 441         mutable++;
 442     }
 443
 444 #ifdef PAR
 445     EvacuateLocalGAs(rtsFalse);
 446 #else
 447     /* evacSPTable( sm ); SP table is now in sm->roots*/
 448 #endif /* PAR */
 449
 450     DEBUG_STRING("Scavenge evacuated old generation roots:");
 451
 452     Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
 453
 454     Scavenge();
 455
 456     old_words = ToHp - old_start;
 457
 458     /* PROMOTE closures rooted in the old generation and reset list of old gen roots */
 459
 460     appelInfo.oldlim = ToHp;
 461
 462     /* SECOND: Evacuate and scavenge remaining roots
 463                These may already have been evacuated -- just get new address
 464     */
 465
 466     EvacuateRoots( sm->roots, sm->rootno );
 467
 468 #if defined(GRAN)
 469     EvacuateEvents();
 470 #endif
 471 #if defined(CONCURRENT) /* && !defined(GRAN) */
 472     EvacuateSparks();
 473 #endif
 474 #if !defined(PAR) /* && !defined(GRAN) */ /* HWL */
 475     EvacuateAStack( MAIN_SpA, stackInfo.botA );
 476     EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
 477     /* ToDo: Optimisation which squeezes out garbage update frames */
 478 #endif  /* PAR */
 479
 480     Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
 481
 482     Scavenge();
 483
 484     appelInfo.oldlim = ToHp;
 485
 486     /* record newly promoted mutuple roots */
 487     MUT_LINK(prevmut) = (W_) appelInfo.PromMutables;
 488     appelInfo.PromMutables = 0;
 489
 490     /* set new generation base, if not fixed */
 491     if (! appelInfo.newfixed) {
 492         appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
 493     }
 494
 495 #ifdef PAR
 496     RebuildGAtables(rtsFalse);
 497 #else
 498     reportDeadForeignObjs(sm->ForeignObjList,
 499                           sm->OldForeignObjList,
 500                           &(sm->OldForeignObjList));
 501     sm->ForeignObjList = NULL;   /* all (new) ForeignObjs have been promoted */
 502 #endif /* PAR */
 503
 504     resident = appelInfo.oldlim - sm->OldLim;
 505     /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */
 506
 507     if (RTSflags.GcFlags.giveStats) {
 508         char minor_str[BIG_STRING_LEN];
 509 #if !defined(PAR) /* && !defined(CONCURRENT) */ /* HWL */
 510         sprintf(minor_str, "%4lu %4ld %3ld %3ld  %4ld        Minor",
 511               (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 512               bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */
 513 #else
 514         /* ToDo: come up with some interesting statistics for the parallel world */
 515         sprintf(minor_str, "%4u %4ld %3ld %3ld  %4ld        Minor",
 516                 0, 0L, sm->rootno, caf_roots, mutable);
 517 #endif
 518         stat_endGC(alloc, alloc, resident, minor_str);
 519     } else {
 520         stat_endGC(alloc, alloc, resident, "");
 521     }
 522
 523     /* Note: if do_full_collection we want to force a full collection. [ADR] */
 524
 525     if (RTSflags.GcFlags.forceGC
 526      && allocd_since_last_major_GC >= RTSflags.GcFlags.forcingInterval) {
 527        do_full_collection = 1;
 528     }
 529
 530     if ((appelInfo.oldlim < appelInfo.oldthresh) &&
 531         (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
 532         (! do_full_collection) ) {
 533
 534         sm->hp = hp_start = appelInfo.newbase - 1;
 535         sm->hplim = appelInfo.newlim;
 536
 537         if (RTSflags.GcFlags.forceGC
 538          && (allocd_since_last_major_GC + (sm->hplim - hp_start) > RTSflags.GcFlags.forcingInterval)) {
 539             sm->hplim = sm->hp + (RTSflags.GcFlags.forcingInterval - allocd_since_last_major_GC);
 540         }
 541
 542         sm->OldLim = appelInfo.oldlim;
 543
 544         if (RTSflags.GcFlags.trace) {
 545             fprintf(stderr, "Minor: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
 546                     (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
 547                     (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
 548                     (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
 549                     (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
 550         }
 551
 552 #ifdef DEBUG
 553         /* To help flush out bugs, we trash the part of the heap from
 554            which we're about to start allocating. */
 555         TrashMem(sm->hp+1, sm->hplim);
 556 #endif /* DEBUG */
 557
 558         RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 559
 560         return GC_SUCCESS;           /* Heap OK -- Enough space to continue */
 561     }
 562
 563     DEBUG_STRING("Major Collection Required");
 564
 565     allocd_since_last_major_GC = 0;
 566
 567     stat_startGC(0);
 568
 569     alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 570
 571     appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
 572     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
 573                           /* For some reason, this doesn't seem to use the last
 574                              allocatable word at appelInfo.newlim */
 575
 576     if (appelInfo.bits <= appelInfo.oldlim) {
 577         fprintf(stderr, "APPEL Major: Not enough space for bit vector\n");
 578         return GC_HARD_LIMIT_EXCEEDED;
 579     }
 580
 581     /* Zero bit vector for marking phase of major collection */
 582     { BitWord *ptr = appelInfo.bits,
 583               *end = appelInfo.bits + appelInfo.bit_words;
 584       while (ptr < end) { *(ptr++) = 0; };
 585     }
 586
 587 #ifdef HAVE_VADVISE
 588     vadvise(VA_ANOM);
 589 #endif
 590
 591     /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAV_REG_MAP */
 592     RESTORE_REGS(&ScavRegDump);
 593
 594     markHeapRoots(sm,
 595                   appelInfo.OldCAFlist,
 596                   NULL,
 597                   appelInfo.oldbase,
 598                   appelInfo.oldlim,
 599                   appelInfo.bits);
 600
 601     SAVE_REGS(&ScavRegDump);
 602     /* end of bracket */
 603
 604 #ifndef PAR
 605     sweepUpDeadForeignObjs(sm->OldForeignObjList,
 606                            appelInfo.oldbase,
 607                            appelInfo.bits
 608                           );
 609 #endif /* !PAR */
 610
 611     /* Reset OldMutables -- this will be reconstructed during scan */
 612     sm->OldMutables = 0;
 613
 614     LinkCAFs(appelInfo.OldCAFlist);
 615
 616     LinkRoots( sm->roots, sm->rootno );
 617 #if defined(GRAN)
 618     LinkEvents();
 619 #endif
 620 #if defined(CONCURRENT)  /* && !defined(GRAN) */
 621     LinkSparks();
 622 #endif
 623 #ifdef PAR
 624     LinkLiveGAs(appelInfo.oldbase, appelInfo.bits);
 625 #else
 626 /*  stable pointers now included in sm->roots -- SOF
 627     DEBUG_STRING("Linking Stable Pointer Table:");
 628     LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
 629 */
 630 #if 1 /* !defined(GRAN) */  /* HWL */
 631     LinkAStack( MAIN_SpA, stackInfo.botA );
 632     LinkBStack( MAIN_SuB, stackInfo.botB );
 633 #endif
 634 #endif
 635
 636     /* Do Inplace Compaction */
 637     /* Returns start of next closure, -1 gives last allocated word */
 638
 639     appelInfo.oldlim = Inplace_Compaction(appelInfo.oldbase,
 640                                           appelInfo.oldlim,
 641                                           0, 0,
 642                                           appelInfo.bits,
 643                                           appelInfo.bit_words
 644 #ifndef PAR
 645                                           ,&(sm->OldForeignObjList)
 646 #endif
 647                                           ) - 1;
 648
 649     appelInfo.oldlast = appelInfo.oldlim;
 650     resident = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 651     DO_MAX_RESIDENCY(resident); /* stats only */
 652
 653     /* set new generation base, if not fixed */
 654     if (! appelInfo.newfixed) {
 655         appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
 656     }
 657
 658     /* set major threshold, if not fixed */
 659     /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */
 660     if (! RTSflags.GcFlags.specifiedOldGenSize) {
 661         appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3;
 662         if (appelInfo.oldthresh > appelInfo.oldmax)
 663             appelInfo.oldthresh = appelInfo.oldmax;
 664     }
 665
 666     sm->hp = hp_start = appelInfo.newbase - 1;
 667     sm->hplim = appelInfo.newlim;
 668
 669     if (RTSflags.GcFlags.forceGC
 670      && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 671         sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 672     }
 673
 674     sm->OldLim = appelInfo.oldlim;
 675
 676 #ifdef HAVE_VADVISE
 677     vadvise(VA_NORM);
 678 #endif
 679
 680     if (RTSflags.GcFlags.giveStats) {
 681         char major_str[BIG_STRING_LEN];
 682 #if !defined(PAR) /* && !defined(CONCURRENT) */  /* HWL */
 683         sprintf(major_str, "%4lu %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
 684                 (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 685                 bstk_roots, sm->rootno, appelInfo.OldCAFno,
 686                 0, 0, resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 687 #else
 688         /* ToDo: come up with some interesting statistics for the parallel world */
 689         sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
 690                 0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0,
 691                 resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 692 #endif
 693
 694         stat_endGC(0, alloc, resident, major_str);
 695     } else {
 696         stat_endGC(0, alloc, resident, "");
 697     }
 698
 699     if (RTSflags.GcFlags.trace) {
 700         fprintf(stderr, "Major: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n        hp 0x%lx, hplim 0x%lx, free %lu\n",
 701                 (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
 702                 (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
 703                 (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
 704                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
 705     }
 706
 707 #ifdef DEBUG
 708     /* To help flush out bugs, we trash the part of the heap from
 709        which we're about to start allocating. */
 710     TrashMem(sm->hp+1, sm->hplim);
 711 #endif /* DEBUG */
 712
 713     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 714
 715     if ((appelInfo.oldlim > appelInfo.oldmax)
 716         || (reqsize > sm->hplim - sm->hp) ) {
 717       return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
 718     } else if (reqsize + sm->hardHpOverflowSize > sm->hplim - sm->hp) {
 719       return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */
 720     } else {
 721       return( GC_SUCCESS );          /* Heap OK */
 722     }
 723 }
 724
 725 #endif /* GCap */
 726
 727 \end{code}