X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FGC.c;h=4e8b3c2a26088b71a7b8f49815ed749c5f68548f;hb=80b1239ee0f6938195d25081601fb2852dcda1e9;hp=d71eaee2e30b710545063e2b5f310de4b3df30f3;hpb=693342ffbb61e1da4c009059755fa0b9b1396bb8;p=ghc-hetmet.git diff --git a/rts/GC.c b/rts/GC.c index d71eaee..4e8b3c2 100644 --- a/rts/GC.c +++ b/rts/GC.c @@ -42,8 +42,9 @@ #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" #endif - +#include "Trace.h" #include "RetainerProfile.h" +#include "RaiseAsync.h" #include @@ -355,10 +356,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) CostCentreStack *prev_CCS; #endif -#if defined(DEBUG) && defined(GRAN) - IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n", - Now, Now)); -#endif + debugTrace(DEBUG_gc, "starting GC"); #if defined(RTS_USER_SIGNALS) // block signals @@ -516,8 +514,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) stp->bitmap = bitmap_bdescr; bitmap = bitmap_bdescr->start; - IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p", - bitmap_size, bitmap);); + debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p", + bitmap_size, bitmap); // don't forget to fill it with zeros! memset(bitmap, 0, bitmap_size); @@ -666,6 +664,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) */ markStablePtrTable(mark_root); + /* Mark the root pointer table. + */ + markRootPtrTable(mark_root); + /* ------------------------------------------------------------------------- * Repeatedly scavenge all the areas we know about until there's no * more scavenging to be done. @@ -824,7 +826,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } copied += mut_list_size; - IF_DEBUG(gc, debugBelch("mut_list_size: %ld (%d vars, %d arrays, %d others)\n", mut_list_size * sizeof(W_), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS)); + debugTrace(DEBUG_gc, + "mut_list_size: %lu (%d vars, %d arrays, %d others)", + (unsigned long)(mut_list_size * sizeof(W_)), + mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS); } for (s = 0; s < generations[g].n_steps; s++) { @@ -1073,7 +1078,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) int pc_free; adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks); - IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks)); + + debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", + RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks); + pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize; if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ { heapOverflow(); @@ -1305,8 +1313,10 @@ traverse_weak_ptr_list(void) w->link = weak_ptr_list; weak_ptr_list = w; flag = rtsTrue; - IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p", - w, w->key)); + + debugTrace(DEBUG_weak, + "weak pointer still alive at %p -> %p", + w, w->key); continue; } else { @@ -1888,8 +1898,6 @@ loop: } return q; - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_NOCAF_STATIC: /* no need to put these on the static linked list, they don't need * to be scavenged. @@ -2192,18 +2200,16 @@ loop: to = copy(q,BLACKHOLE_sizeW(),stp); //ToDo: derive size etc from reverted IP //to = copy(q,size,stp); - IF_DEBUG(gc, - debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)", - q, info_type(q), to, info_type(to))); + debugTrace(DEBUG_gc, "evacuate: RBH %p (%s) to %p (%s)", + q, info_type(q), to, info_type(to)); return to; } - + case BLOCKED_FETCH: ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE); to = copy(q,sizeofW(StgBlockedFetch),stp); - IF_DEBUG(gc, - debugBelch("@@ evacuate: %p (%s) to %p (%s)", - q, info_type(q), to, info_type(to))); + debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)", + q, info_type(q), to, info_type(to)); return to; # ifdef DIST @@ -2212,25 +2218,23 @@ loop: case FETCH_ME: ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE); to = copy(q,sizeofW(StgFetchMe),stp); - IF_DEBUG(gc, - debugBelch("@@ evacuate: %p (%s) to %p (%s)", - q, info_type(q), to, info_type(to))); + debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)", + q, info_type(q), to, info_type(to))); return to; case FETCH_ME_BQ: ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE); to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); - IF_DEBUG(gc, - debugBelch("@@ evacuate: %p (%s) to %p (%s)", - q, info_type(q), to, info_type(to))); + debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)", + q, info_type(q), to, info_type(to))); return to; #endif case TREC_HEADER: return copy(q,sizeofW(StgTRecHeader),stp); - case TVAR_WAIT_QUEUE: - return copy(q,sizeofW(StgTVarWaitQueue),stp); + case TVAR_WATCH_QUEUE: + return copy(q,sizeofW(StgTVarWatchQueue),stp); case TVAR: return copy(q,sizeofW(StgTVar),stp); @@ -2238,6 +2242,12 @@ loop: case TREC_CHUNK: return copy(q,sizeofW(StgTRecChunk),stp); + case ATOMIC_INVARIANT: + return copy(q,sizeofW(StgAtomicInvariant),stp); + + case INVARIANT_CHECK_QUEUE: + return copy(q,sizeofW(StgInvariantCheckQueue),stp); + default: barf("evacuate: strange closure type %d", (int)(info->type)); } @@ -2626,10 +2636,8 @@ scavengeTSO (StgTSO *tso) ) { tso->block_info.closure = evacuate(tso->block_info.closure); } - if ( tso->blocked_exceptions != NULL ) { - tso->blocked_exceptions = - (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions); - } + tso->blocked_exceptions = + (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions); // We don't always chase the link field: TSOs on the blackhole // queue are not automatically alive, so the link field is a @@ -3068,9 +3076,8 @@ scavenge(step *stp) (StgClosure *)rbh->blocking_queue = evacuate((StgClosure *)rbh->blocking_queue); failed_to_evac = rtsTrue; // mutable anyhow. - IF_DEBUG(gc, - debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue)); + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue); // ToDo: use size of reverted closure here! p += BLACKHOLE_sizeW(); break; @@ -3085,10 +3092,9 @@ scavenge(step *stp) // follow the link to the rest of the blocking queue (StgClosure *)bf->link = evacuate((StgClosure *)bf->link); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); + debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); p += sizeofW(StgBlockedFetch); break; } @@ -3105,24 +3111,23 @@ scavenge(step *stp) StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = evacuate((StgClosure *)fmbq->blocking_queue); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); p += sizeofW(StgFetchMeBlockingQueue); break; } #endif - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: { - StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); evac_gen = 0; - wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); - wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); - wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTVarWaitQueue); + p += sizeofW(StgTVarWatchQueue); break; } @@ -3131,7 +3136,7 @@ scavenge(step *stp) StgTVar *tvar = ((StgTVar *) p); evac_gen = 0; tvar->current_value = evacuate((StgClosure*)tvar->current_value); - tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTVar); @@ -3144,6 +3149,7 @@ scavenge(step *stp) evac_gen = 0; trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecHeader); @@ -3168,6 +3174,31 @@ scavenge(step *stp) break; } + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgAtomicInvariant); + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgInvariantCheckQueue); + break; + } + default: barf("scavenge: unimplemented/strange closure type %d @ %p", info->type, p); @@ -3460,9 +3491,8 @@ linear_scan: bh->blocking_queue = (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); failed_to_evac = rtsTrue; // mutable anyhow. - IF_DEBUG(gc, - debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue)); + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue)); break; } @@ -3475,10 +3505,9 @@ linear_scan: // follow the link to the rest of the blocking queue (StgClosure *)bf->link = evacuate((StgClosure *)bf->link); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); + debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); break; } @@ -3493,20 +3522,19 @@ linear_scan: StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = evacuate((StgClosure *)fmbq->blocking_queue); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); break; } #endif /* PAR */ - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: { - StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); evac_gen = 0; - wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); - wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); - wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; @@ -3517,7 +3545,7 @@ linear_scan: StgTVar *tvar = ((StgTVar *) p); evac_gen = 0; tvar->current_value = evacuate((StgClosure*)tvar->current_value); - tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; @@ -3546,11 +3574,35 @@ linear_scan: evac_gen = 0; trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; } + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + default: barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", info->type, p); @@ -3570,7 +3622,7 @@ linear_scan: // start a new linear scan if the mark stack overflowed at some point if (mark_stack_overflowed && oldgen_scan_bd == NULL) { - IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan")); + debugTrace(DEBUG_gc, "scavenge_mark_stack: starting linear scan"); mark_stack_overflowed = rtsFalse; oldgen_scan_bd = oldest_gen->steps[0].old_blocks; oldgen_scan = oldgen_scan_bd->start; @@ -3812,9 +3864,8 @@ scavenge_one(StgPtr p) (StgClosure *)rbh->blocking_queue = evacuate((StgClosure *)rbh->blocking_queue); failed_to_evac = rtsTrue; // mutable anyhow. - IF_DEBUG(gc, - debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", - p, info_type(p), (StgClosure *)rbh->blocking_queue)); + debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue)); // ToDo: use size of reverted closure here! break; } @@ -3828,10 +3879,10 @@ scavenge_one(StgPtr p) // follow the link to the rest of the blocking queue (StgClosure *)bf->link = evacuate((StgClosure *)bf->link); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", - bf, info_type((StgClosure *)bf), - bf->node, info_type(bf->node))); + debugTrace(DEBUG_gc, + "scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); break; } @@ -3846,20 +3897,19 @@ scavenge_one(StgPtr p) StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = evacuate((StgClosure *)fmbq->blocking_queue); - IF_DEBUG(gc, - debugBelch("@@ scavenge: %p (%s) exciting, isn't it", - p, info_type((StgClosure *)p))); + debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); break; } #endif - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: { - StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); evac_gen = 0; - wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); - wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); - wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure); + wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; @@ -3870,7 +3920,7 @@ scavenge_one(StgPtr p) StgTVar *tvar = ((StgTVar *) p); evac_gen = 0; tvar->current_value = evacuate((StgClosure*)tvar->current_value); - tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); + tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; @@ -3882,6 +3932,7 @@ scavenge_one(StgPtr p) evac_gen = 0; trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check); evac_gen = saved_evac_gen; failed_to_evac = rtsTrue; // mutable break; @@ -3904,6 +3955,29 @@ scavenge_one(StgPtr p) break; } + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + evac_gen = 0; + invariant->code = (StgClosure *)evacuate(invariant->code); + invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + evac_gen = 0; + queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant); + queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution); + queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } + case IND_OLDGEN: case IND_OLDGEN_PERM: case IND_STATIC: @@ -4176,8 +4250,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end) StgWord bitmap; nat size; - //IF_DEBUG(sanity, debugBelch(" scavenging stack between %p and %p", p, stack_end)); - /* * Each time around this loop, we are looking at a chunk of stack * that starts with an activation record. @@ -4437,11 +4509,11 @@ gcCAFs(void) ASSERT(info->type == IND_STATIC); if (STATIC_LINK(info,p) == NULL) { - IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p)); - // black hole it - SET_INFO(p,&stg_BLACKHOLE_info); - p = STATIC_LINK2(info,p); - *pp = p; + debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p); + // black hole it + SET_INFO(p,&stg_BLACKHOLE_info); + p = STATIC_LINK2(info,p); + *pp = p; } else { pp = &STATIC_LINK2(info,p); @@ -4451,7 +4523,7 @@ gcCAFs(void) } - // debugBelch("%d CAFs live", i); + debugTrace(DEBUG_gccafs, "%d CAFs live", i); } #endif @@ -4625,6 +4697,14 @@ threadPaused(Capability *cap, StgTSO *tso) nat weight_pending = 0; rtsBool prev_was_update_frame; + // Check to see whether we have threads waiting to raise + // exceptions, and we're not blocking exceptions, or are blocked + // interruptibly. This is important; if a thread is running with + // TSO_BLOCKEX and becomes blocked interruptibly, this is the only + // place we ensure that the blocked_exceptions get a chance. + maybePerformBlockedException (cap, tso); + if (tso->what_next == ThreadKilled) { return; } + stack_end = &tso->stack[tso->stack_size]; frame = (StgClosure *)tso->sp; @@ -4646,7 +4726,9 @@ threadPaused(Capability *cap, StgTSO *tso) bh = ((StgUpdateFrame *)frame)->updatee; if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) { - IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %ld words of stack\n", (StgPtr)frame - tso->sp)); + debugTrace(DEBUG_squeeze, + "suspending duplicate work: %ld words of stack", + (long)((StgPtr)frame - tso->sp)); // If this closure is already an indirection, then // suspend the computation up to this point: @@ -4706,10 +4788,10 @@ threadPaused(Capability *cap, StgTSO *tso) } end: - IF_DEBUG(squeeze, - debugBelch("words_to_squeeze: %d, weight: %d, squeeze: %s\n", - words_to_squeeze, weight, - weight < words_to_squeeze ? "YES" : "NO")); + debugTrace(DEBUG_squeeze, + "words_to_squeeze: %d, weight: %d, squeeze: %s", + words_to_squeeze, weight, + weight < words_to_squeeze ? "YES" : "NO"); // Should we squeeze or not? Arbitrary heuristic: we squeeze if // the number of words we have to shift down is less than the @@ -4731,7 +4813,7 @@ printMutableList(generation *gen) bdescr *bd; StgPtr p; - debugBelch("@@ Mutable list %p: ", gen->mut_list); + debugBelch("mutable list %p: ", gen->mut_list); for (bd = gen->mut_list; bd != NULL; bd = bd->link) { for (p = bd->start; p < bd->free; p++) {