X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FGC.c;h=4e8b3c2a26088b71a7b8f49815ed749c5f68548f;hb=220dec863e89103983698d253c6087d2f85c037f;hp=727027dd930d2f937be8bad7e84d56816bb29883;hpb=5a2769f0273dd389977e8283375e7920d183bdd4;p=ghc-hetmet.git diff --git a/rts/GC.c b/rts/GC.c index 727027d..4e8b3c2 100644 --- a/rts/GC.c +++ b/rts/GC.c @@ -44,6 +44,7 @@ #endif #include "Trace.h" #include "RetainerProfile.h" +#include "RaiseAsync.h" #include @@ -826,8 +827,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) copied += mut_list_size; debugTrace(DEBUG_gc, - "mut_list_size: %ld (%d vars, %d arrays, %d others)", - mut_list_size * sizeof(W_), + "mut_list_size: %lu (%d vars, %d arrays, %d others)", + (unsigned long)(mut_list_size * sizeof(W_)), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS); } @@ -1897,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. @@ -2234,8 +2233,8 @@ loop: 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); @@ -2243,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)); } @@ -2631,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 @@ -3115,16 +3118,16 @@ scavenge(step *stp) } #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; } @@ -3133,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); @@ -3146,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); @@ -3170,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); @@ -3499,13 +3528,13 @@ linear_scan: } #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; @@ -3516,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; @@ -3545,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); @@ -3850,13 +3903,13 @@ scavenge_one(StgPtr p) } #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; @@ -3867,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; @@ -3879,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; @@ -3901,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: @@ -4620,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; @@ -4643,7 +4728,7 @@ threadPaused(Capability *cap, StgTSO *tso) if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) { debugTrace(DEBUG_squeeze, "suspending duplicate work: %ld words of stack", - (StgPtr)frame - tso->sp); + (long)((StgPtr)frame - tso->sp)); // If this closure is already an indirection, then // suspend the computation up to this point: