--- /dev/null
+\section[PerformGC]{Wrapper for heap overflow}
+
+\begin{code}
+#include "rtsdefs.h"
+\end{code}
+
+@PerformGC@ is the wrapper for calls to @collectHeap@ in the
+storage manager. It performs the following actions:
+\begin{enumerate}
+\item Save live registers.
+\item If black holing is required before garbage collection we must
+black hole the update frames on the B stack and any live registers
+pointing at updatable closures --- possibly R1, if live and in update? --JSM
+\item Call the garbage collector.
+\item Restore registers.
+\end{enumerate}
+They either succeed or crash-and-burn; hence, they don't return
+anything.
+
+@PerformGC@ saves the fixed STG registers. and calls the garbage
+collector. It also black holes the B Stack if this is required at
+garbage collection time.
+
+There's also a function @PerformGCIO@ which does all the above and is
+used to force a full collection.
+
+\begin{code}
+#if defined(CONCURRENT)
+EXTFUN(EnterNodeCode); /* For reentering node after GC */
+EXTFUN(CheckHeapCode); /* For returning to thread after a context switch */
+extern P_ AvailableStack;
+# if defined(PAR)
+EXTDATA_RO(FetchMe_info);
+# endif
+#else
+static void BlackHoleUpdateStack(STG_NO_ARGS);
+#endif /* CONCURRENT */
+
+extern smInfo StorageMgrInfo;
+extern void PrintRednCountInfo(STG_NO_ARGS);
+extern I_ showRednCountStats;
+extern I_ SM_word_heap_size;
+extern I_ squeeze_upd_frames;
+
+#if defined(GRAN_CHECK) && defined(GRAN)
+extern W_ debug;
+#endif
+#ifdef GRAN
+extern FILE *main_statsfile; /* Might be of general interest HWL */
+#endif
+
+/* the real work is done by this function --- see wrappers at end */
+
+void
+RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
+ W_ liveness;
+ W_ reqsize;
+ W_ always_reenter_node;
+ rtsBool do_full_collection;
+{
+ I_ num_ptr_roots = 0; /* we bump this counter as we
+ store roots; de-bump it
+ as we re-store them. */
+#if defined(USE_COST_CENTRES)
+ CostCentre Save_CCC;
+#endif
+
+ /* stop the profiling timer --------------------- */
+#if defined(USE_COST_CENTRES)
+/* STOP_TIME_PROFILER; */
+#endif
+
+#ifdef CONCURRENT
+
+ SAVE_Liveness = liveness;
+
+ /*
+ Even on a uniprocessor, we may have to reenter node after a
+ context switch. Though it can't turn into a FetchMe, its shape
+ may have changed (e.g. from a thunk to a data object).
+ */
+ if (always_reenter_node) {
+ /* Avoid infinite loops at the same heap check */
+ if (SAVE_Hp <= SAVE_HpLim && TSO_SWITCH(CurrentTSO) == TSO_PC2(CurrentTSO)) {
+ TSO_SWITCH(CurrentTSO) = NULL;
+ return;
+ }
+ /* Set up to re-enter Node, so as to be sure it's really there. */
+ assert(liveness & LIVENESS_R1);
+ TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
+ TSO_PC2(CurrentTSO) = EnterNodeCode;
+ }
+
+ SAVE_Hp -= reqsize;
+
+ if (context_switch && !do_full_collection
+# if defined(USE_COST_CENTRES)
+ && !interval_expired
+# endif
+ ) {
+ /* We're in a GC callWrapper, so the thread state is safe */
+ TSO_ARG1(CurrentTSO) = reqsize;
+ TSO_PC1(CurrentTSO) = CheckHeapCode;
+# ifdef PAR
+ if (do_gr_profile) {
+ TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO);
+ }
+# endif
+# if defined(GRAN)
+ ReSchedule(9 /*i.e. error; was SAME_THREAD*/);
+# else
+ ReSchedule(1);
+# endif
+ }
+
+ /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
+# if defined(USE_COST_CENTRES)
+ Save_CCC = CCC;
+# endif
+ CCC = (CostCentre)STATIC_CC_REF(CC_GC);
+ CCC->scc_count++;
+
+ ReallyPerformThreadGC(reqsize, do_full_collection);
+
+#else /* !CONCURRENT */
+
+# if defined(USE_COST_CENTRES)
+ /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */
+ Save_CCC = CCC;
+ CCC = (CostCentre)STATIC_CC_REF(CC_GC);
+ CCC->scc_count++;
+# endif
+
+ /* root saving ---------------------------------- */
+
+# define __ENROOT_PTR_REG(cond,n) /* n == 1 <=> R1 */ \
+ do { if ( cond ) { \
+ StorageMgrInfo.roots[num_ptr_roots] = CAT2(MAIN_R,n).p; \
+ num_ptr_roots++; \
+ }} while (0)
+
+ __ENROOT_PTR_REG(IS_LIVE_R1(liveness),1);
+ __ENROOT_PTR_REG(IS_LIVE_R2(liveness),2);
+ __ENROOT_PTR_REG(IS_LIVE_R3(liveness),3);
+ __ENROOT_PTR_REG(IS_LIVE_R4(liveness),4);
+ __ENROOT_PTR_REG(IS_LIVE_R5(liveness),5);
+ __ENROOT_PTR_REG(IS_LIVE_R6(liveness),6);
+ __ENROOT_PTR_REG(IS_LIVE_R7(liveness),7);
+ __ENROOT_PTR_REG(IS_LIVE_R8(liveness),8);
+
+ /*
+ * Before we garbage collect we may have to squeeze update frames and/or
+ * black hole the update stack
+ */
+ if (squeeze_upd_frames) {
+ /* Squeeze and/or black hole update frames */
+ I_ displacement;
+
+ displacement = SqueezeUpdateFrames(stackInfo.botB + BREL(1), MAIN_SpB, MAIN_SuB);
+
+ MAIN_SuB += BREL(displacement);
+ MAIN_SpB += BREL(displacement);
+ /* fprintf(stderr, "B size %d, squeezed out %d\n", MAIN_SpB - stackInfo.botB,
+ displacement); */
+ } /* note the conditional else clause below */
+# if defined(SM_DO_BH_UPDATE)
+ else
+ BlackHoleUpdateStack();
+# endif /* SM_DO_BH_UPDATE */
+
+ assert(num_ptr_roots <= SM_MAXROOTS);
+ StorageMgrInfo.rootno = num_ptr_roots;
+
+ SAVE_Hp -= reqsize;
+ /* Move (SAVE_)Hp back to where it was */
+ /* (heap is known to grow upwards) */
+ /* we *do* have to do this, so reported stats will be right! */
+
+ /* the main business ---------------------------- */
+
+ blockUserSignals();
+
+ {
+ int GC_result;
+
+ /* Restore hpLim to its "correct" setting */
+ StorageMgrInfo.hplim += StorageMgrInfo.hardHpOverflowSize;
+
+ GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection);
+
+ if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) {
+ OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
+ shutdownHaskell();
+ EXIT(EXIT_FAILURE);
+
+ } else if ( GC_result == GC_SOFT_LIMIT_EXCEEDED ) {
+ /* Allow ourselves to use emergency space */
+ /* Set hplim so that we'll GC when we hit the soft limit */
+ StorageMgrInfo.hplim -= StorageMgrInfo.hardHpOverflowSize;
+ raiseError( softHeapOverflowHandler );
+
+ } else if ( GC_result == GC_SUCCESS ) {
+ /* Set hplim so that we'll GC when we hit the soft limit */
+ StorageMgrInfo.hplim -= StorageMgrInfo.hardHpOverflowSize;
+
+ } else { /* This should not happen */
+ fprintf(stderr, "Panic: garbage collector returned %d please report it as a bug to glasgow-haskell-bugs@dcs.gla.ac.uk\n", GC_result );
+
+# if defined(DO_REDN_COUNTING)
+ if (showRednCountStats) {
+ PrintRednCountInfo();
+ }
+# endif
+ abort();
+ }
+ }
+
+ StorageMgrInfo.rootno = 0; /* reset */
+
+ SAVE_Hp += reqsize;
+ /* Semantics of GC ensures that a block of
+ `reqsize' is now available (and allocated) [NB: sequential only] */
+
+ /* root restoring ------------------------------- */
+ /* must do all the restoring exactly backwards to the storing! */
+
+ /* now the general regs, in *backwards* order */
+
+# define __DEROOT_PTR_REG(cond,n) /* n == 1 <=> R1 */ \
+ do { if ( cond ) { \
+ num_ptr_roots--; \
+ CAT2(MAIN_R,n).p = StorageMgrInfo.roots[num_ptr_roots]; \
+ }} while (0)
+
+ __DEROOT_PTR_REG(IS_LIVE_R8(liveness),8);
+ __DEROOT_PTR_REG(IS_LIVE_R7(liveness),7);
+ __DEROOT_PTR_REG(IS_LIVE_R6(liveness),6);
+ __DEROOT_PTR_REG(IS_LIVE_R5(liveness),5);
+ __DEROOT_PTR_REG(IS_LIVE_R4(liveness),4);
+ __DEROOT_PTR_REG(IS_LIVE_R3(liveness),3);
+ __DEROOT_PTR_REG(IS_LIVE_R2(liveness),2);
+ __DEROOT_PTR_REG(IS_LIVE_R1(liveness),1);
+
+ assert(num_ptr_roots == 0); /* we have put it all back */
+
+ unblockUserSignals();
+
+#endif /* !CONCURRENT */
+
+#if defined(USE_COST_CENTRES)
+ CCC = Save_CCC;
+
+ RESTART_TIME_PROFILER;
+#endif
+}
+\end{code}
+
+This is a wrapper used for all standard, non-threaded, non-parallel GC
+purposes.
+\begin{code}
+#ifdef HEAP_CHK_HYGIENE
+I_ doHygieneCheck = 0;
+#endif
+
+void
+PerformGC(args)
+ W_ args;
+{
+ W_ liveness = HEAP_OVERFLOW_LIVENESS(args);
+ W_ reqsize = HEAP_OVERFLOW_REQSIZE(args);
+ W_ always_reenter_node = HEAP_OVERFLOW_REENTER(args);
+
+#ifdef HEAP_CHK_HYGIENE
+ if (doHygieneCheck) {
+ checkHygiene();
+ return;
+ }
+#endif
+ RealPerformGC(liveness, reqsize, always_reenter_node, rtsFalse);
+}
+
+#if defined(CONCURRENT) && defined(GRAN)
+/* This is directly called from the macro GRAN_RESCHEDULE out of the */
+/* threaded world. -- HWL */
+
+void
+PerformReschedule(liveness, always_reenter_node)
+ W_ liveness;
+ W_ always_reenter_node;
+
+{
+ I_ need_to_reschedule;
+
+ /* Reset the global NeedToReSchedule --
+ this is used only to communicate the fact that we should schedule
+ a new thread rather than the existing one following a fetch.
+ */
+ need_to_reschedule = NeedToReSchedule;
+ NeedToReSchedule = rtsFalse;
+
+ SAVE_Liveness = liveness;
+
+ if (always_reenter_node) {
+ /* Avoid infinite loops at the same context switch */
+ if ((TSO_SWITCH(CurrentTSO) == TSO_PC2(CurrentTSO)) &&
+ !need_to_reschedule) {
+ TSO_SWITCH(CurrentTSO) = NULL;
+ return;
+ }
+
+ /* Set up to re-enter Node, so as to be sure it's really there. */
+ assert(liveness & LIVENESS_R1);
+ TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO);
+ TSO_PC2(CurrentTSO) = (void *) EnterNodeCode;
+ }
+
+ /* We're in a GC callWrapper, so the thread state is safe */
+ TSO_ARG1(CurrentTSO) = 0;
+ TSO_PC1(CurrentTSO) = EnterNodeCode;
+ ReSchedule( (need_to_reschedule && !DoReScheduleOnFetch) ?
+ CHANGE_THREAD : SAME_THREAD );
+}
+#endif
+
+#ifndef PAR
+/* this is a wrapper used when we want to do a full GC.
+
+ One reason might be that we're about to enter a time-critical piece
+ of code and want to reduce the risk of a GC during the run. The
+ motivating reason is that we want to force the GC to report any
+ dead Malloc Pointers to us.
+
+ Note: this should only be called using _ccall_GC_ which saves all
+ registers in the usual place (ie the global save area) before the
+ call and restores them afterwards.
+
+ ToDo: put in a runtime check that _ccall_GC_ is in action. */
+
+void
+StgPerformGarbageCollection()
+{
+# if ! defined(__STG_GCC_REGS__)
+ SaveAllStgRegs(); /* unregisterised case */
+# endif
+
+ RealPerformGC(0,0,0,rtsTrue);
+
+# if ! defined(__STG_GCC_REGS__)
+ RestoreAllStgRegs(); /* unregisterised case */
+# endif
+}
+#endif /* !PAR */
+
+#ifdef CONCURRENT
+
+# if defined(GRAN)
+
+/* Jim's spark pools are very similar to our processors, except that
+ he uses a hard-wired constant. This would be a mistake for us,
+ since we won't always need this many pools.
+*/
+void
+PruneSparks(STG_NO_ARGS)
+{
+ sparkq spark, prev, next;
+ I_ proc, pool, prunedSparks;
+
+ for(proc=0; proc<max_proc; ++proc) {
+ prev = NULL;
+
+ for (pool = 0; pool < SPARK_POOLS; pool++) {
+ prunedSparks=0;
+
+ for(spark = PendingSparksHd[proc][pool];
+ spark != NULL;
+ spark = next) {
+ next = SPARK_NEXT(spark);
+
+ /* HACK! The first clause should actually never happen HWL */
+
+ if ( (SPARK_NODE(spark) == NULL) ||
+ (SPARK_NODE(spark) == Nil_closure) ) {
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark);
+# endif
+ if (do_qp_prof)
+ QP_Event0(threadId++, SPARK_NODE(spark));
+
+ if(do_sp_profile)
+ DumpRawGranEvent(CURRENT_PROC,SP_PRUNED,(W_) spark);
+
+ DisposeSpark(spark);
+ prunedSparks++;
+ }
+ else if (SHOULD_SPARK(SPARK_NODE(spark))) {
+ /* Keep it */
+ if (prev == NULL)
+ PendingSparksHd[proc][pool] = spark;
+ else
+ SPARK_NEXT(prev) = spark;
+ SPARK_PREV(spark) = prev;
+ prev = spark;
+ } else {
+ if (do_qp_prof)
+ QP_Event0(threadId++, SPARK_NODE(spark));
+
+ if(do_sp_profile)
+ DumpRawGranEvent(CURRENT_PROC,SP_PRUNED,(W_) spark);
+
+ DisposeSpark(spark);
+ prunedSparks++;
+ }
+ } /* forall spark ... */
+ if (prev == NULL)
+ PendingSparksHd[proc][pool] = NULL;
+ else
+ SPARK_NEXT(prev) = NULL;
+ PendingSparksTl[proc][pool] = prev;
+ if (prunedSparks>0)
+ fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n",
+ prunedSparks,(W_) MAX_SPARKS,proc);
+ } /* forall pool ... */
+ } /* forall proc ... */
+}
+
+# else /* !GRAN */
+
+void
+PruneSparks(STG_NO_ARGS)
+{
+ I_ pool;
+
+ PP_ old;
+ PP_ new;
+
+ for (pool = 0; pool < SPARK_POOLS; pool++) {
+ new = PendingSparksBase[pool];
+ for (old = PendingSparksHd[pool]; old < PendingSparksTl[pool]; old++) {
+ if (SHOULD_SPARK(*old)) {
+ /* Keep it */
+ *new++ = *old;
+ } else {
+ if (DO_QP_PROF)
+ QP_Event0(threadId++, *old);
+# ifdef PAR
+ if(do_sp_profile)
+ DumpSparkGranEvent(SP_PRUNED, threadId++);
+# endif
+ }
+ }
+ PendingSparksHd[pool] = PendingSparksBase[pool];
+ PendingSparksTl[pool] = new;
+ }
+}
+
+# endif /* !GRAN */
+
+\end{code}
+
+This is the real GC wrapper for the threaded world. No context
+switching or other nonsense... just set up StorageMgrInfo and perform
+a garbage collection.
+
+\begin{code}
+
+void
+ReallyPerformThreadGC(reqsize, do_full_collection)
+W_ reqsize;
+rtsBool do_full_collection;
+{
+# if defined(GRAN)
+ I_ proc;
+#endif
+
+ I_ num_ptr_roots = 0; /* we bump this counter as we store roots; de-bump it
+ as we re-store them. */
+ P_ stack, tso, next;
+
+ /* Discard the saved stack and TSO space */
+
+ for(stack = AvailableStack; stack != Nil_closure; stack = next) {
+ next = STKO_LINK(stack);
+ FREEZE_MUT_HDR(stack, ImMutArrayOfPtrs_info);
+ MUTUPLE_CLOSURE_SIZE(stack) = MUTUPLE_VHS;
+ }
+
+ for(tso = AvailableTSO; tso != Nil_closure; tso = next) {
+ next = TSO_LINK(tso);
+ FREEZE_MUT_HDR(tso, ImMutArrayOfPtrs_info);
+ MUTUPLE_CLOSURE_SIZE(tso) = MUTUPLE_VHS;
+ }
+
+ AvailableStack = AvailableTSO = Nil_closure;
+
+ PruneSparks();
+
+# if defined(GRAN)
+ for(proc = 0; proc < max_proc; ++proc) {
+
+# if 0
+ for(i = 0; i < SPARK_POOLS; i++) {
+ if (PendingSparksHd[proc][i] != NULL)
+ StorageMgrInfo.roots[num_ptr_roots++] = PendingSparksHd[proc][i];
+ if ( PendingSparksTl[proc][i] != NULL)
+ StorageMgrInfo.roots[num_ptr_roots++] = PendingSparksTl[proc][i];
+ }
+# endif /* 0 */
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
+ num_ptr_roots,proc,RunnableThreadsHd[proc]);
+# endif
+
+ StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd[proc];
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
+ num_ptr_roots,proc,RunnableThreadsTl[proc]);
+# endif
+ StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
+ } /* forall proc ... */
+
+ num_ptr_roots = SaveSparkRoots(num_ptr_roots);
+ num_ptr_roots = SaveEventRoots(num_ptr_roots);
+
+# else /* !GRAN */
+
+ StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd;
+ StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl;
+ StorageMgrInfo.roots[num_ptr_roots++] = WaitingThreadsHd;
+ StorageMgrInfo.roots[num_ptr_roots++] = WaitingThreadsTl;
+
+# endif /* !GRAN */
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Saving CurrentTSO %d -- 0x%lx\n",
+ num_ptr_roots,CurrentTSO);
+# endif
+
+ StorageMgrInfo.roots[num_ptr_roots++] = CurrentTSO;
+
+# ifdef PAR
+ StorageMgrInfo.roots[num_ptr_roots++] = PendingFetches;
+# endif
+
+ StorageMgrInfo.rootno = num_ptr_roots;
+
+ blockUserSignals();
+
+ if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) {
+
+ OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/
+
+# if defined(DO_REDN_COUNTING)
+ if (showRednCountStats) {
+ PrintRednCountInfo();
+ }
+# endif
+ EXIT(EXIT_FAILURE);
+ }
+
+ StorageMgrInfo.rootno = 0; /* reset */
+
+ /* root restoring ------------------------------- */
+ /* must do all the restoring exactly backwards to the storing! */
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Restoring CurrentTSO %d -- new: 0x%lx\n",
+ num_ptr_roots-1,StorageMgrInfo.roots[num_ptr_roots-1]);
+# endif
+
+# ifdef PAR
+ PendingFetches = StorageMgrInfo.roots[--num_ptr_roots];
+# endif
+ CurrentTSO = StorageMgrInfo.roots[--num_ptr_roots];
+ CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
+
+# if !defined(GRAN)
+
+ WaitingThreadsTl = StorageMgrInfo.roots[--num_ptr_roots];
+ WaitingThreadsHd = StorageMgrInfo.roots[--num_ptr_roots];
+
+ RunnableThreadsTl = StorageMgrInfo.roots[--num_ptr_roots];
+ RunnableThreadsHd = StorageMgrInfo.roots[--num_ptr_roots];
+
+# else /* GRAN */
+
+ num_ptr_roots = RestoreEventRoots(num_ptr_roots);
+ num_ptr_roots = RestoreSparkRoots(num_ptr_roots);
+
+ /* NB: PROC is unsigned datatype i.e. (PROC)-1 == (PROC)255 */
+
+ for(proc = max_proc - 1; (proc >= 0) && (proc < max_proc) ; --proc) {
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
+ num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
+# endif
+
+ RunnableThreadsTl[proc] = StorageMgrInfo.roots[--num_ptr_roots];
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ if ( debug & 0x40 )
+ fprintf(main_statsfile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
+ num_ptr_roots,proc,StorageMgrInfo.roots[num_ptr_roots]);
+# endif
+
+ RunnableThreadsHd[proc] = StorageMgrInfo.roots[--num_ptr_roots];
+
+# if 0
+ for(i = SPARK_POOLS - 1; i >= 0; --i) {
+ if (PendingSparksTl[proc][i] != NULL)
+ PendingSparksTl[proc][i] = StorageMgrInfo.roots[--num_ptr_roots];
+ if (PendingSparksHd[proc][i] != NULL)
+ PendingSparksHd[proc][i] = StorageMgrInfo.roots[--num_ptr_roots];
+ }
+# endif
+ }
+
+# endif /* GRAN */
+
+ /* Semantics of GC ensures that a block of `reqsize' is now available */
+ SAVE_Hp += reqsize;
+
+ unblockUserSignals();
+}
+
+#endif /* CONCURRENT */
+
+\end{code}
+
+This routine rattles down the B stack, black-holing any
+pending updates to avoid space leaks from them.
+
+\begin{code}
+#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE)
+
+static
+void
+BlackHoleUpdateStack(STG_NO_ARGS)
+{
+ P_ PtrToUpdateFrame;
+
+ if (noBlackHoles)
+ return;
+
+ PtrToUpdateFrame = MAIN_SuB;
+
+ /* ToDo: There may be an optimisation here which stops at the first
+ BHed closure on the stack as all below must have been BHed */
+
+ while (SUBTRACT_B_STK(PtrToUpdateFrame, stackInfo.botB) > 0) {
+
+ UPD_BH(GRAB_UPDATEE(PtrToUpdateFrame), BH_UPD_info);
+
+ /* Move PtrToUpdateFrame down B Stack */
+ PtrToUpdateFrame = GRAB_SuB(PtrToUpdateFrame);
+ }
+}
+#endif /* CONCURRENT && SM_DO_BH_UPDATE */
+\end{code}
+
+
+\begin{code}
+#if defined(CONCURRENT) && !defined(GRAN)
+void
+PerformReschedule(liveness, always_reenter_node)
+ W_ liveness;
+ W_ always_reenter_node;
+
+{ }
+#endif
+\end{code}
projects / ghc-hetmet.git / blobdiff