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