ghc/runtime/c-as-asm/HpOverflow.lc

   1 \section[PerformGC]{Wrapper for heap overflow}
   2
   3 \begin{code}
   4 #include "rtsdefs.h"
   5 \end{code}
   6
   7 @PerformGC@ is the wrapper for calls to @collectHeap@ in the
   8 storage manager. It performs the following actions:
   9 \begin{enumerate}
  10 \item Save live registers.
  11 \item If black holing is required before garbage collection we must
  12 black hole the update frames on the B stack and any live registers
  13 pointing at updatable closures --- possibly R1, if live and in update? --JSM
  14 \item Call the garbage collector.
  15 \item Restore registers.
  16 \end{enumerate}
  17 They either succeed or crash-and-burn; hence, they don't return
  18 anything.
  19
  20 @PerformGC@ saves the fixed STG registers. and calls the garbage
  21 collector. It also black holes the B Stack if this is required at
  22 garbage collection time.
  23
  24 There's also a function @PerformGCIO@ which does all the above and is
  25 used to force a full collection.
  26
  27 \begin{code}
  28 #if defined(CONCURRENT)
  29 EXTFUN(EnterNodeCode);          /* For reentering node after GC */
  30 EXTFUN(CheckHeapCode);          /* For returning to thread after a context switch */
  31 extern P_ AvailableStack;
  32 # if defined(PAR)
  33 EXTDATA_RO(FetchMe_info);
  34 # endif
  35 #else
  36 static void BlackHoleUpdateStack(STG_NO_ARGS);
  37 #endif /* CONCURRENT */
  38
  39 extern smInfo StorageMgrInfo;
  40 extern void PrintRednCountInfo(STG_NO_ARGS);
  41 extern I_   showRednCountStats;
  42 extern I_   SM_word_heap_size;
  43 extern I_   squeeze_upd_frames;
  44
  45 #if defined(GRAN_CHECK) && defined(GRAN)
  46 extern W_ debug;
  47 #endif
  48 #ifdef GRAN
  49 extern FILE *main_statsfile;         /* Might be of general interest  HWL */
  50 #endif
  51
  52 /* the real work is done by this function --- see wrappers at end */
  53
  54 void
  55 RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
  56   W_ liveness;
  57   W_ reqsize;
  58   W_  always_reenter_node;
  59   rtsBool do_full_collection;
  60 {
  61     I_ num_ptr_roots = 0; /* we bump this counter as we
  62                                  store roots; de-bump it
  63                                  as we re-store them. */
  64 #if defined(USE_COST_CENTRES)
  65     CostCentre Save_CCC;
  66 #endif
  67
  68     /* stop the profiling timer --------------------- */
  69 #if defined(USE_COST_CENTRES)
  70 /*    STOP_TIME_PROFILER; */
  71 #endif
  72
  73 #ifdef CONCURRENT
  74
  75     SAVE_Liveness = liveness;
  76
  77     /*
  78        Even on a uniprocessor, we may have to reenter node after a
  79        context switch.  Though it can't turn into a FetchMe, its shape
  80        may have changed (e.g. from a thunk to a data object).
  81      */
  82     if (always_reenter_node) {
  83         /* Avoid infinite loops at the same heap check */
  84         if (SAVE_Hp <= SAVE_HpLim && TSO_SWITCH(CurrentTSO) == TSO_PC2(CurrentTSO)) {
  85             TSO_SWITCH(CurrentTSO) = NULL;
  86             return;
  87         }
  88         /* Set up to re-enter Node, so as to be sure it's really there. */
  89         assert(liveness & LIVENESS_R1);
  90         TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
  91         TSO_PC2(CurrentTSO) = EnterNodeCode;
  92     }
  93
  94     SAVE_Hp -= reqsize;
  95
  96     if (context_switch && !do_full_collection
  97 # if defined(USE_COST_CENTRES)
  98        && !interval_expired
  99 # endif
 100       ) {
 101         /* We're in a GC callWrapper, so the thread state is safe */
 102         TSO_ARG1(CurrentTSO) = reqsize;
 103         TSO_PC1(CurrentTSO) = CheckHeapCode;
 104 # ifdef PAR
 105         if (do_gr_profile) {
 106             TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
 107         }
 108 # endif
 109 # if defined(GRAN)
 110         ReSchedule(9 /*i.e. error; was SAME_THREAD*/);
 111 # else
 112         ReSchedule(1);
 113 # endif
 114     }
 115
 116     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
 117 # if defined(USE_COST_CENTRES)
 118     Save_CCC = CCC;
 119 # endif
 120     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
 121     CCC->scc_count++;
 122
 123     ReallyPerformThreadGC(reqsize, do_full_collection);
 124
 125 #else   /* !CONCURRENT */
 126
 127 # if defined(USE_COST_CENTRES)
 128     /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
 129     Save_CCC = CCC;
 130     CCC = (CostCentre)STATIC_CC_REF(CC_GC);
 131     CCC->scc_count++;
 132 # endif
 133
 134     /* root saving ---------------------------------- */
 135
 136 # define __ENROOT_PTR_REG(cond,n) /* n == 1 <=> R1 */   \
 137         do { if ( cond ) {                              \
 138         StorageMgrInfo.roots[num_ptr_roots] = CAT2(MAIN_R,n).p; \
 139         num_ptr_roots++;                                \
 140         }} while (0)
 141
 142     __ENROOT_PTR_REG(IS_LIVE_R1(liveness),1);
 143     __ENROOT_PTR_REG(IS_LIVE_R2(liveness),2);
 144     __ENROOT_PTR_REG(IS_LIVE_R3(liveness),3);
 145     __ENROOT_PTR_REG(IS_LIVE_R4(liveness),4);
 146     __ENROOT_PTR_REG(IS_LIVE_R5(liveness),5);
 147     __ENROOT_PTR_REG(IS_LIVE_R6(liveness),6);
 148     __ENROOT_PTR_REG(IS_LIVE_R7(liveness),7);
 149     __ENROOT_PTR_REG(IS_LIVE_R8(liveness),8);
 150
 151     /*
 152      * Before we garbage collect we may have to squeeze update frames and/or
 153      * black hole the update stack
 154     */
 155     if (squeeze_upd_frames) {
 156         /* Squeeze and/or black hole update frames */
 157         I_ displacement;
 158
 159         displacement = SqueezeUpdateFrames(stackInfo.botB + BREL(1), MAIN_SpB, MAIN_SuB);
 160
 161         MAIN_SuB += BREL(displacement);
 162         MAIN_SpB += BREL(displacement);
 163         /* fprintf(stderr, "B size %d, squeezed out %d\n", MAIN_SpB - stackInfo.botB,
 164                 displacement); */
 165     }   /* note the conditional else clause below */
 166 # if defined(SM_DO_BH_UPDATE)
 167     else
 168         BlackHoleUpdateStack();
 169 # endif /* SM_DO_BH_UPDATE */
 170
 171     assert(num_ptr_roots <= SM_MAXROOTS);
 172     StorageMgrInfo.rootno = num_ptr_roots;
 173
 174     SAVE_Hp -= reqsize;
 175         /* Move (SAVE_)Hp back to where it was */
 176         /* (heap is known to grow upwards) */
 177         /* we *do* have to do this, so reported stats will be right! */
 178
 179     /* the main business ---------------------------- */
 180
 181     blockUserSignals();
 182
 183     {
 184       int GC_result;
 185
 186       /* Restore hpLim to its "correct" setting */
 187       StorageMgrInfo.hplim += StorageMgrInfo.hardHpOverflowSize;
 188
 189       GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection);
 190
 191       if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) {
 192         OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
 193         shutdownHaskell();
 194         EXIT(EXIT_FAILURE);
 195
 196       } else if ( GC_result == GC_SOFT_LIMIT_EXCEEDED ) {
 197         /* Allow ourselves to use emergency space */
 198         /* Set hplim so that we'll GC when we hit the soft limit */
 199         StorageMgrInfo.hplim -= StorageMgrInfo.hardHpOverflowSize;
 200         raiseError( softHeapOverflowHandler );
 201
 202       } else if ( GC_result == GC_SUCCESS ) {
 203         /* Set hplim so that we'll GC when we hit the soft limit */
 204         StorageMgrInfo.hplim -= StorageMgrInfo.hardHpOverflowSize;
 205
 206       } else { /* This should not happen */
 207         fprintf(stderr, "Panic: garbage collector returned %d please report it as a bug to glasgow-haskell-bugs@dcs.gla.ac.uk\n", GC_result );
 208
 209 # if defined(DO_REDN_COUNTING)
 210         if (showRednCountStats) {
 211            PrintRednCountInfo();
 212         }
 213 # endif
 214         abort();
 215       }
 216     }
 217
 218     StorageMgrInfo.rootno = 0;  /* reset */
 219
 220     SAVE_Hp += reqsize;
 221     /* Semantics of GC ensures that a block of
 222         `reqsize' is now available (and allocated) [NB: sequential only] */
 223
 224     /* root restoring ------------------------------- */
 225     /* must do all the restoring exactly backwards to the storing! */
 226
 227     /* now the general regs, in *backwards* order */
 228
 229 # define __DEROOT_PTR_REG(cond,n) /* n == 1 <=> R1 */   \
 230         do { if ( cond ) {                              \
 231         num_ptr_roots--;                                \
 232         CAT2(MAIN_R,n).p = StorageMgrInfo.roots[num_ptr_roots]; \
 233         }} while (0)
 234
 235     __DEROOT_PTR_REG(IS_LIVE_R8(liveness),8);
 236     __DEROOT_PTR_REG(IS_LIVE_R7(liveness),7);
 237     __DEROOT_PTR_REG(IS_LIVE_R6(liveness),6);
 238     __DEROOT_PTR_REG(IS_LIVE_R5(liveness),5);
 239     __DEROOT_PTR_REG(IS_LIVE_R4(liveness),4);
 240     __DEROOT_PTR_REG(IS_LIVE_R3(liveness),3);
 241     __DEROOT_PTR_REG(IS_LIVE_R2(liveness),2);
 242     __DEROOT_PTR_REG(IS_LIVE_R1(liveness),1);
 243
 244     assert(num_ptr_roots == 0); /* we have put it all back */
 245
 246     unblockUserSignals();
 247
 248 #endif  /* !CONCURRENT */
 249
 250 #if defined(USE_COST_CENTRES)
 251     CCC = Save_CCC;
 252
 253     RESTART_TIME_PROFILER;
 254 #endif
 255 }
 256 \end{code}
 257
 258 This is a wrapper used for all standard, non-threaded, non-parallel GC
 259 purposes.
 260 \begin{code}
 261 #ifdef HEAP_CHK_HYGIENE
 262 I_ doHygieneCheck = 0;
 263 #endif
 264
 265 void
 266 PerformGC(args)
 267   W_ args;
 268 {
 269     W_ liveness = HEAP_OVERFLOW_LIVENESS(args);
 270     W_ reqsize = HEAP_OVERFLOW_REQSIZE(args);
 271     W_ always_reenter_node = HEAP_OVERFLOW_REENTER(args);
 272
 273 #ifdef HEAP_CHK_HYGIENE
 274     if (doHygieneCheck) {
 275         checkHygiene();
 276         return;
 277     }
 278 #endif
 279     RealPerformGC(liveness, reqsize, always_reenter_node, rtsFalse);
 280 }
 281
 282 #if defined(CONCURRENT) && defined(GRAN)
 283 /* This is directly called from the macro GRAN_RESCHEDULE out of the */
 284 /* threaded world. -- HWL */
 285
 286 void
 287 PerformReschedule(liveness, always_reenter_node)
 288   W_ liveness;
 289   W_  always_reenter_node;
 290
 291 {
 292     I_ need_to_reschedule;
 293
 294     /* Reset the global NeedToReSchedule --
 295        this is used only to communicate the fact that we should schedule
 296        a new thread rather than the existing one following a fetch.
 297     */
 298     need_to_reschedule = NeedToReSchedule;
 299     NeedToReSchedule = rtsFalse;
 300
 301     SAVE_Liveness = liveness;
 302
 303     if (always_reenter_node) {
 304       /* Avoid infinite loops at the same context switch */
 305         if ((TSO_SWITCH(CurrentTSO) == TSO_PC2(CurrentTSO)) &&
 306             !need_to_reschedule) {
 307             TSO_SWITCH(CurrentTSO) = NULL;
 308             return;
 309         }
 310
 311       /* Set up to re-enter Node, so as to be sure it's really there. */
 312       assert(liveness & LIVENESS_R1);
 313       TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
 314       TSO_PC2(CurrentTSO) = (void *) EnterNodeCode;
 315     }
 316
 317     /* We're in a GC callWrapper, so the thread state is safe */
 318     TSO_ARG1(CurrentTSO) = 0;
 319     TSO_PC1(CurrentTSO) = EnterNodeCode;
 320     ReSchedule( (need_to_reschedule && !DoReScheduleOnFetch) ?
 321                 CHANGE_THREAD : SAME_THREAD );
 322 }
 323 #endif
 324
 325 #ifndef PAR
 326 /* this is a wrapper used when we want to do a full GC.
 327
 328    One reason might be that we're about to enter a time-critical piece
 329    of code and want to reduce the risk of a GC during the run.  The
 330    motivating reason is that we want to force the GC to report any
 331    dead Malloc Pointers to us.
 332
 333    Note: this should only be called using _ccall_GC_ which saves all
 334    registers in the usual place (ie the global save area) before the
 335    call and restores them afterwards.
 336
 337    ToDo: put in a runtime check that _ccall_GC_ is in action. */
 338
 339 void
 340 StgPerformGarbageCollection()
 341 {
 342 # if ! defined(__STG_GCC_REGS__)
 343     SaveAllStgRegs();   /* unregisterised case */
 344 # endif
 345
 346     RealPerformGC(0,0,0,rtsTrue);
 347
 348 # if ! defined(__STG_GCC_REGS__)
 349     RestoreAllStgRegs();    /* unregisterised case */
 350 # endif
 351 }
 352 #endif /* !PAR */
 353
 354 #ifdef CONCURRENT
 355
 356 # if defined(GRAN)
 357
 358 /* Jim's spark pools are very similar to our processors, except that
 359    he uses a hard-wired constant.  This would be a mistake for us,
 360    since we won't always need this many pools.
 361 */
 362 void
 363 PruneSparks(STG_NO_ARGS)
 364 {
 365     sparkq spark, prev, next;
 366     I_ proc, pool, prunedSparks;
 367
 368     for(proc=0; proc<max_proc; ++proc) {
 369     prev = NULL;
 370
 371     for (pool = 0; pool < SPARK_POOLS; pool++) {
 372     prunedSparks=0;
 373
 374     for(spark = PendingSparksHd[proc][pool];
 375         spark != NULL;
 376         spark = next) {
 377         next = SPARK_NEXT(spark);
 378
 379         /* HACK! The first clause should actually never happen  HWL */
 380
 381         if ( (SPARK_NODE(spark) == NULL) ||
 382              (SPARK_NODE(spark) == Nil_closure) ) {
 383 #  if defined(GRAN_CHECK) && defined(GRAN)
 384               if ( debug & 0x40 )
 385                 fprintf(main_statsfile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark);
 386 #  endif
 387             if (do_qp_prof)
 388                 QP_Event0(threadId++, SPARK_NODE(spark));
 389
 390             if(do_sp_profile)
 391               DumpRawGranEvent(CURRENT_PROC,SP_PRUNED,(W_) spark);
 392
 393             DisposeSpark(spark);
 394             prunedSparks++;
 395             }
 396         else if (SHOULD_SPARK(SPARK_NODE(spark))) {
 397             /* Keep it */
 398             if (prev == NULL)
 399                 PendingSparksHd[proc][pool] = spark;
 400             else
 401                 SPARK_NEXT(prev) = spark;
 402             SPARK_PREV(spark) = prev;
 403             prev = spark;
 404         } else {
 405             if (do_qp_prof)
 406                 QP_Event0(threadId++, SPARK_NODE(spark));
 407
 408             if(do_sp_profile)
 409               DumpRawGranEvent(CURRENT_PROC,SP_PRUNED,(W_) spark);
 410
 411             DisposeSpark(spark);
 412             prunedSparks++;
 413         }
 414     }  /* forall spark ... */
 415     if (prev == NULL)
 416         PendingSparksHd[proc][pool] = NULL;
 417     else
 418         SPARK_NEXT(prev) = NULL;
 419     PendingSparksTl[proc][pool] = prev;
 420     if (prunedSparks>0)
 421       fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n",
 422               prunedSparks,(W_) MAX_SPARKS,proc);
 423    }  /* forall pool ... */
 424   }   /* forall proc ... */
 425 }
 426
 427 # else  /* !GRAN */
 428
 429 void
 430 PruneSparks(STG_NO_ARGS)
 431 {
 432     I_ pool;
 433
 434     PP_ old;
 435     PP_ new;
 436
 437     for (pool = 0; pool < SPARK_POOLS; pool++) {
 438         new = PendingSparksBase[pool];
 439         for (old = PendingSparksHd[pool]; old < PendingSparksTl[pool]; old++) {
 440             if (SHOULD_SPARK(*old)) {
 441                 /* Keep it */
 442                 *new++ = *old;
 443             } else {
 444                 if (DO_QP_PROF)
 445                     QP_Event0(threadId++, *old);
 446 #  ifdef PAR
 447                 if(do_sp_profile)
 448                     DumpSparkGranEvent(SP_PRUNED, threadId++);
 449 #  endif
 450             }
 451         }
 452         PendingSparksHd[pool] = PendingSparksBase[pool];
 453         PendingSparksTl[pool] = new;
 454     }
 455 }
 456
 457 # endif  /* !GRAN */
 458
 459 \end{code}
 460
 461 This is the real GC wrapper for the threaded world.  No context
 462 switching or other nonsense... just set up StorageMgrInfo and perform
 463 a garbage collection.
 464
 465 \begin{code}
 466
 467 void
 468 ReallyPerformThreadGC(reqsize, do_full_collection)
 469 W_ reqsize;
 470 rtsBool do_full_collection;
 471 {
 472 # if defined(GRAN)
 473     I_ proc;
 474 #endif
 475
 476     I_ num_ptr_roots = 0;        /* we bump this counter as we store roots; de-bump it
 477                                     as we re-store them. */
 478     P_ stack, tso, next;
 479
 480     /* Discard the saved stack and TSO space */
 481
 482     for(stack = AvailableStack; stack != Nil_closure; stack = next) {
 483         next = STKO_LINK(stack);
 484         FREEZE_MUT_HDR(stack, ImMutArrayOfPtrs_info);
 485         MUTUPLE_CLOSURE_SIZE(stack) = MUTUPLE_VHS;
 486     }
 487
 488     for(tso = AvailableTSO; tso != Nil_closure; tso = next) {
 489         next = TSO_LINK(tso);
 490         FREEZE_MUT_HDR(tso, ImMutArrayOfPtrs_info);
 491         MUTUPLE_CLOSURE_SIZE(tso) = MUTUPLE_VHS;
 492     }
 493
 494     AvailableStack = AvailableTSO = Nil_closure;
 495
 496     PruneSparks();
 497
 498 # if defined(GRAN)
 499     for(proc = 0; proc < max_proc; ++proc) {
 500
 501 #  if 0
 502     for(i = 0; i < SPARK_POOLS; i++) {
 503       if (PendingSparksHd[proc][i] != NULL)
 504         StorageMgrInfo.roots[num_ptr_roots++] = PendingSparksHd[proc][i];
 505       if ( PendingSparksTl[proc][i] != NULL)
 506         StorageMgrInfo.roots[num_ptr_roots++] = PendingSparksTl[proc][i];
 507      }
 508 #  endif /* 0 */
 509
 510 #  if defined(GRAN_CHECK) && defined(GRAN)
 511               if ( debug & 0x40 )
 512                 fprintf(main_statsfile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
 513                         num_ptr_roots,proc,RunnableThreadsHd[proc]);
 514 #  endif
 515
 516     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd[proc];
 517
 518 #  if defined(GRAN_CHECK) && defined(GRAN)
 519               if ( debug & 0x40 )
 520                 fprintf(main_statsfile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
 521                         num_ptr_roots,proc,RunnableThreadsTl[proc]);
 522 #  endif
 523     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
 524     }  /* forall proc ... */
 525
 526     num_ptr_roots = SaveSparkRoots(num_ptr_roots);
 527     num_ptr_roots = SaveEventRoots(num_ptr_roots);
 528
 529 # else /* !GRAN */
 530
 531     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd;
 532     StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl;
 533     StorageMgrInfo.roots[num_ptr_roots++] = WaitingThreadsHd;
 534     StorageMgrInfo.roots[num_ptr_roots++] = WaitingThreadsTl;
 535
 536 # endif /* !GRAN */
 537
 538 # if defined(GRAN_CHECK) && defined(GRAN)
 539     if ( debug & 0x40 )
 540       fprintf(main_statsfile,"Saving CurrentTSO %d -- 0x%lx\n",
 541               num_ptr_roots,CurrentTSO);
 542 # endif
 543
 544     StorageMgrInfo.roots[num_ptr_roots++] = CurrentTSO;
 545
 546 #  ifdef PAR
 547     StorageMgrInfo.roots[num_ptr_roots++] = PendingFetches;
 548 #  endif
 549
 550     StorageMgrInfo.rootno = num_ptr_roots;
 551
 552     blockUserSignals();
 553
 554     if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) {
 555
 556         OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
 557
 558 # if defined(DO_REDN_COUNTING)
 559         if (showRednCountStats) {
 560             PrintRednCountInfo();
 561         }
 562 # endif
 563         EXIT(EXIT_FAILURE);
 564     }
 565
 566     StorageMgrInfo.rootno = 0;  /* reset */
 567
 568     /* root restoring ------------------------------- */
 569     /* must do all the restoring exactly backwards to the storing! */
 570
 571 # if defined(GRAN_CHECK) && defined(GRAN)
 572           if ( debug & 0x40 )
 573             fprintf(main_statsfile,"Restoring CurrentTSO %d -- new: 0x%lx\n",
 574                     num_ptr_roots-1,StorageMgrInfo.roots[num_ptr_roots-1]);
 575 # endif
 576
 577 # ifdef PAR
 578     PendingFetches = StorageMgrInfo.roots[--num_ptr_roots];
 579 # endif
 580     CurrentTSO = StorageMgrInfo.roots[--num_ptr_roots];
 581     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
 582
 583 # if !defined(GRAN)
 584
 585     WaitingThreadsTl = StorageMgrInfo.roots[--num_ptr_roots];
 586     WaitingThreadsHd = StorageMgrInfo.roots[--num_ptr_roots];
 587
 588     RunnableThreadsTl = StorageMgrInfo.roots[--num_ptr_roots];
 589     RunnableThreadsHd = StorageMgrInfo.roots[--num_ptr_roots];
 590
 591 # else /* GRAN */
 592
 593     num_ptr_roots = RestoreEventRoots(num_ptr_roots);
 594     num_ptr_roots = RestoreSparkRoots(num_ptr_roots);
 595
 596     /* NB: PROC is unsigned datatype i.e. (PROC)-1 == (PROC)255  */
 597
 598     for(proc = max_proc - 1; (proc >= 0) && (proc < max_proc) ; --proc) {
 599
 600 #  if defined(GRAN_CHECK) && defined(GRAN)
 601           if ( debug & 0x40 )
 602             fprintf(main_statsfile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
 603                     num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
 604 #  endif
 605
 606     RunnableThreadsTl[proc] = StorageMgrInfo.roots[--num_ptr_roots];
 607
 608 #  if defined(GRAN_CHECK) && defined(GRAN)
 609           if ( debug & 0x40 )
 610             fprintf(main_statsfile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
 611                     num_ptr_roots,proc,StorageMgrInfo.roots[num_ptr_roots]);
 612 #  endif
 613
 614     RunnableThreadsHd[proc] = StorageMgrInfo.roots[--num_ptr_roots];
 615
 616 #  if 0
 617     for(i = SPARK_POOLS - 1; i >= 0; --i) {
 618       if (PendingSparksTl[proc][i] != NULL)
 619         PendingSparksTl[proc][i] =  StorageMgrInfo.roots[--num_ptr_roots];
 620       if (PendingSparksHd[proc][i] != NULL)
 621         PendingSparksHd[proc][i] =  StorageMgrInfo.roots[--num_ptr_roots];
 622      }
 623 #  endif
 624     }
 625
 626 # endif /* GRAN */
 627
 628     /* Semantics of GC ensures that a block of `reqsize' is now available */
 629     SAVE_Hp += reqsize;
 630
 631     unblockUserSignals();
 632 }
 633
 634 #endif /* CONCURRENT */
 635
 636 \end{code}
 637
 638 This routine rattles down the B stack, black-holing any
 639 pending updates to avoid space leaks from them.
 640
 641 \begin{code}
 642 #if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
 643
 644 static
 645 void
 646 BlackHoleUpdateStack(STG_NO_ARGS)
 647 {
 648     P_ PtrToUpdateFrame;
 649
 650     if (noBlackHoles)
 651         return;
 652
 653     PtrToUpdateFrame = MAIN_SuB;
 654
 655     /* ToDo: There may be an optimisation here which stops at the first
 656              BHed closure on the stack as all below must have been BHed */
 657
 658     while (SUBTRACT_B_STK(PtrToUpdateFrame, stackInfo.botB) > 0) {
 659
 660         UPD_BH(GRAB_UPDATEE(PtrToUpdateFrame), BH_UPD_info);
 661
 662         /* Move PtrToUpdateFrame down B Stack */
 663         PtrToUpdateFrame = GRAB_SuB(PtrToUpdateFrame);
 664     }
 665 }
 666 #endif  /* CONCURRENT && SM_DO_BH_UPDATE */
 667 \end{code}
 668
 669
 670 \begin{code}
 671 #if defined(CONCURRENT) && !defined(GRAN)
 672 void
 673 PerformReschedule(liveness, always_reenter_node)
 674   W_ liveness;
 675   W_  always_reenter_node;
 676
 677 { }
 678 #endif
 679 \end{code}