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)
 249     EvacuateSparks();
 250 #endif
 251 #if !defined(PAR)
 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)
 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 #if 0 && defined(GRAN)
 445     {
 446       extern ex_RBH_q;
 447       closq prev_ptr, clos_ptr;
 448
 449       DEBUG_STRING("Evacuate reverted RBHs:");
 450       clos_ptr = ex_RBH_q;
 451       while ( clos_ptr ) {
 452
 453         /* Scavenge the OldMutable */
 454         P_ info = (P_) INFO_PTR(CLOS_CLOSURE(clos_ptr));
 455         StgScavPtr scav_code = SCAV_CODE(info);
 456         Scav = CLOS_CLOSURE(clos_ptr);
 457         (scav_code)();
 458
 459         /* No mutable closure are put on the ex_RBH_q */
 460         /* ASSERT(IS_MUTABLE(info)); */
 461         prev_ptr = clos_ptr;
 462         clos_ptr = CLOS_NEXT(clos_ptr);
 463         free(prev_ptr);
 464       }
 465       ex_RBH_q = NULL;
 466     }
 467 #endif /* GRAN */
 468
 469 #ifdef PAR
 470     EvacuateLocalGAs(rtsFalse);
 471 #else
 472     /* evacSPTable( sm ); SP table is now in sm->roots*/
 473 #endif /* PAR */
 474
 475     DEBUG_STRING("Scavenge evacuated old generation roots:");
 476
 477     Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
 478
 479     Scavenge();
 480
 481     old_words = ToHp - old_start;
 482
 483     /* PROMOTE closures rooted in the old generation and reset list of old gen roots */
 484
 485     appelInfo.oldlim = ToHp;
 486
 487     /* SECOND: Evacuate and scavenge remaining roots
 488                These may already have been evacuated -- just get new address
 489     */
 490
 491     EvacuateRoots( sm->roots, sm->rootno );
 492
 493 #if defined(GRAN)
 494     EvacuateEvents();
 495 #endif
 496 #if defined(CONCURRENT)
 497     EvacuateSparks();
 498 #endif
 499 #if !defined(PAR)
 500     EvacuateAStack( MAIN_SpA, stackInfo.botA );
 501     EvacuateBStack( MAIN_SuB, stackInfo.botB, &bstk_roots );
 502     /* ToDo: Optimisation which squeezes out garbage update frames */
 503 #endif  /* PAR */
 504
 505     Scav = appelInfo.oldlim + 1; /* Point to (info field of) first closure */
 506
 507     Scavenge();
 508
 509     appelInfo.oldlim = ToHp;
 510
 511     /* record newly promoted mutuple roots */
 512     MUT_LINK(prevmut) = (W_) appelInfo.PromMutables;
 513     appelInfo.PromMutables = 0;
 514
 515     /* set new generation base, if not fixed */
 516     if (! appelInfo.newfixed) {
 517         appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
 518     }
 519
 520 #ifdef PAR
 521     RebuildGAtables(rtsFalse);
 522 #else
 523     reportDeadForeignObjs(sm->ForeignObjList,
 524                           sm->OldForeignObjList,
 525                           &(sm->OldForeignObjList));
 526     sm->ForeignObjList = NULL;   /* all (new) ForeignObjs have been promoted */
 527 #endif /* PAR */
 528
 529     resident = appelInfo.oldlim - sm->OldLim;
 530     /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */
 531
 532     if (RTSflags.GcFlags.giveStats) {
 533         char minor_str[BIG_STRING_LEN];
 534 #if !defined(PAR)
 535         sprintf(minor_str, "%4lu %4ld %3ld %3ld  %4ld        Minor",
 536               (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 537               bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */
 538 #else
 539         /* ToDo: come up with some interesting statistics for the parallel world */
 540         sprintf(minor_str, "%4u %4ld %3ld %3ld  %4ld        Minor",
 541                 0, 0L, sm->rootno, caf_roots, mutable);
 542 #endif
 543         stat_endGC(alloc, alloc, resident, minor_str);
 544     } else {
 545         stat_endGC(alloc, alloc, resident, "");
 546     }
 547
 548     /* Note: if do_full_collection we want to force a full collection. [ADR] */
 549
 550     if (RTSflags.GcFlags.forceGC
 551      && allocd_since_last_major_GC >= RTSflags.GcFlags.forcingInterval) {
 552        do_full_collection = 1;
 553     }
 554
 555     if ((appelInfo.oldlim < appelInfo.oldthresh) &&
 556         (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) &&
 557         (! do_full_collection) ) {
 558
 559         sm->hp = hp_start = appelInfo.newbase - 1;
 560         sm->hplim = appelInfo.newlim;
 561
 562         if (RTSflags.GcFlags.forceGC
 563          && (allocd_since_last_major_GC + (sm->hplim - hp_start) > RTSflags.GcFlags.forcingInterval)) {
 564             sm->hplim = sm->hp + (RTSflags.GcFlags.forcingInterval - allocd_since_last_major_GC);
 565         }
 566
 567         sm->OldLim = appelInfo.oldlim;
 568
 569         if (RTSflags.GcFlags.trace) {
 570             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",
 571                     (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
 572                     (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
 573                     (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
 574                     (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
 575         }
 576
 577 #ifdef DEBUG
 578         /* To help flush out bugs, we trash the part of the heap from
 579            which we're about to start allocating. */
 580         TrashMem(sm->hp+1, sm->hplim);
 581 #endif /* DEBUG */
 582
 583         RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 584
 585         return GC_SUCCESS;           /* Heap OK -- Enough space to continue */
 586     }
 587
 588     DEBUG_STRING("Major Collection Required");
 589
 590     allocd_since_last_major_GC = 0;
 591
 592     stat_startGC(0);
 593
 594     alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 595
 596     appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord);
 597     appelInfo.bits      = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words;
 598                           /* For some reason, this doesn't seem to use the last
 599                              allocatable word at appelInfo.newlim */
 600
 601     if (appelInfo.bits <= appelInfo.oldlim) {
 602         fprintf(stderr, "APPEL Major: Not enough space for bit vector\n");
 603         return GC_HARD_LIMIT_EXCEEDED;
 604     }
 605
 606     /* Zero bit vector for marking phase of major collection */
 607     { BitWord *ptr = appelInfo.bits,
 608               *end = appelInfo.bits + appelInfo.bit_words;
 609       while (ptr < end) { *(ptr++) = 0; };
 610     }
 611
 612 #ifdef HAVE_VADVISE
 613     vadvise(VA_ANOM);
 614 #endif
 615
 616     /* bracket use of MARK_REG_MAP with RESTORE/SAVE of SCAV_REG_MAP */
 617     RESTORE_REGS(&ScavRegDump);
 618
 619     markHeapRoots(sm,
 620                   appelInfo.OldCAFlist,
 621                   NULL,
 622                   appelInfo.oldbase,
 623                   appelInfo.oldlim,
 624                   appelInfo.bits);
 625
 626     SAVE_REGS(&ScavRegDump);
 627     /* end of bracket */
 628
 629 #ifndef PAR
 630     sweepUpDeadForeignObjs(sm->OldForeignObjList,
 631                            appelInfo.oldbase,
 632                            appelInfo.bits
 633                           );
 634 #endif /* !PAR */
 635
 636     /* Reset OldMutables -- this will be reconstructed during scan */
 637     sm->OldMutables = 0;
 638
 639     LinkCAFs(appelInfo.OldCAFlist);
 640
 641     LinkRoots( sm->roots, sm->rootno );
 642 #if defined(GRAN)
 643     LinkEvents();
 644 #endif
 645 #if defined(CONCURRENT)
 646     LinkSparks();
 647 #endif
 648 #ifdef PAR
 649     LinkLiveGAs(appelInfo.oldbase, appelInfo.bits);
 650 #else
 651 /*  stable pointers now included in sm->roots -- SOF
 652     DEBUG_STRING("Linking Stable Pointer Table:");
 653     LINK_LOCATION_TO_CLOSURE(&sm->StablePointerTable);
 654 */
 655     LinkAStack( MAIN_SpA, stackInfo.botA );
 656     LinkBStack( MAIN_SuB, stackInfo.botB );
 657 #endif
 658
 659     /* Do Inplace Compaction */
 660     /* Returns start of next closure, -1 gives last allocated word */
 661
 662     appelInfo.oldlim = Inplace_Compaction(appelInfo.oldbase,
 663                                           appelInfo.oldlim,
 664                                           0, 0,
 665                                           appelInfo.bits,
 666                                           appelInfo.bit_words
 667 #ifndef PAR
 668                                           ,&(sm->OldForeignObjList)
 669 #endif
 670                                           ) - 1;
 671
 672     appelInfo.oldlast = appelInfo.oldlim;
 673     resident = (appelInfo.oldlim - appelInfo.oldbase) + 1;
 674     DO_MAX_RESIDENCY(resident); /* stats only */
 675
 676     /* set new generation base, if not fixed */
 677     if (! appelInfo.newfixed) {
 678         appelInfo.newbase = appelInfo.oldlim + 1 + (((appelInfo.newlim - appelInfo.oldlim) + 1) / 2);
 679     }
 680
 681     /* set major threshold, if not fixed */
 682     /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */
 683     if (! RTSflags.GcFlags.specifiedOldGenSize) {
 684         appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3;
 685         if (appelInfo.oldthresh > appelInfo.oldmax)
 686             appelInfo.oldthresh = appelInfo.oldmax;
 687     }
 688
 689     sm->hp = hp_start = appelInfo.newbase - 1;
 690     sm->hplim = appelInfo.newlim;
 691
 692     if (RTSflags.GcFlags.forceGC
 693      && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) {
 694         sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval;
 695     }
 696
 697     sm->OldLim = appelInfo.oldlim;
 698
 699 #ifdef HAVE_VADVISE
 700     vadvise(VA_NORM);
 701 #endif
 702
 703     if (RTSflags.GcFlags.giveStats) {
 704         char major_str[BIG_STRING_LEN];
 705 #if !defined(PAR)
 706         sprintf(major_str, "%4lu %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
 707                 (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1),
 708                 bstk_roots, sm->rootno, appelInfo.OldCAFno,
 709                 0, 0, resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 710 #else
 711         /* ToDo: come up with some interesting statistics for the parallel world */
 712         sprintf(major_str, "%4u %4ld %3ld %3ld  %4d %4d  *Major* %4.1f%%",
 713                 0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0,
 714                 resident / (StgDouble) RTSflags.GcFlags.heapSize * 100);
 715 #endif
 716
 717         stat_endGC(0, alloc, resident, major_str);
 718     } else {
 719         stat_endGC(0, alloc, resident, "");
 720     }
 721
 722     if (RTSflags.GcFlags.trace) {
 723         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",
 724                 (W_) appelInfo.newbase,   (W_) appelInfo.newlim,
 725                 (W_) appelInfo.oldbase,   (W_) appelInfo.oldlim,
 726                 (W_) appelInfo.oldthresh, (W_) appelInfo.oldmax,
 727                 (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_));
 728     }
 729
 730 #ifdef DEBUG
 731     /* To help flush out bugs, we trash the part of the heap from
 732        which we're about to start allocating. */
 733     TrashMem(sm->hp+1, sm->hplim);
 734 #endif /* DEBUG */
 735
 736     RESTORE_REGS(&ScavRegDump);     /* Restore Registers */
 737
 738     if ((appelInfo.oldlim > appelInfo.oldmax)
 739         || (reqsize > sm->hplim - sm->hp) ) {
 740       return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */
 741     } else if (reqsize + sm->hardHpOverflowSize > sm->hplim - sm->hp) {
 742       return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */
 743     } else {
 744       return( GC_SUCCESS );          /* Heap OK */
 745     /* linked = IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) !=
 746        MUT_NOT_LINKED; */
 747     }
 748 }
 749
 750 #endif /* GCap */
 751
 752 \end{code}