#include "PosixSource.h"
#include "Rts.h"
+
+#include "GCThread.h"
+#include "Storage.h"
#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
#include "BlockAlloc.h"
-#include "MBlock.h"
#include "GC.h"
#include "Compact.h"
#include "Schedule.h"
#include "Apply.h"
#include "Trace.h"
+#include "Weak.h"
+#include "MarkWeak.h"
+#include "Stable.h"
// Turn off inlining when debugging - it obfuscates things
#ifdef DEBUG
case 1:
{
StgWord r = *(StgPtr)(q-1);
- ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
+ ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r)));
return r;
}
case 2:
case CATCH_STM_FRAME:
case ATOMICALLY_FRAME:
case UPDATE_FRAME:
- case STOP_FRAME:
- case CATCH_FRAME:
+ case UNDERFLOW_FRAME:
+ case STOP_FRAME:
+ case CATCH_FRAME:
case RET_SMALL:
bitmap = BITMAP_BITS(info->i.layout.bitmap);
size = BITMAP_SIZE(info->i.layout.bitmap);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole
- || tso->why_blocked == BlockedOnException
+ || tso->why_blocked == BlockedOnMsgThrowTo
) {
thread_(&tso->block_info.closure);
}
thread_(&tso->blocked_exceptions);
+ thread_(&tso->bq);
thread_(&tso->trec);
- thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
- return (StgPtr)tso + tso_sizeW(tso);
+ thread_(&tso->stackobj);
+ return (StgPtr)tso + sizeofW(StgTSO);
}
for (; bd != NULL; bd = bd->link) {
+ // nothing to do in a pinned block; it might not even have an object
+ // at the beginning.
+ if (bd->flags & BF_PINNED) continue;
+
p = bd->start;
info = get_itbl((StgClosure *)p);
case MUT_ARR_PTRS_FROZEN0:
// follow everything
{
- StgPtr next;
+ StgMutArrPtrs *a;
- next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- thread((StgClosure **)p);
- }
- continue;
+ a = (StgMutArrPtrs*)p;
+ for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+ thread((StgClosure **)p);
+ }
+ continue;
}
- case TSO:
- thread_TSO((StgTSO *)p);
- continue;
+ case STACK:
+ {
+ StgStack *stack = (StgStack*)p;
+ thread_stack(stack->sp, stack->stack + stack->stack_size);
+ continue;
+ }
case AP_STACK:
thread_AP_STACK((StgAP_STACK *)p);
case FUN:
case CONSTR:
- case STABLE_NAME:
- case IND_PERM:
+ case PRIM:
+ case MUT_PRIM:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
- case CAF_BLACKHOLE:
case BLACKHOLE:
+ case BLOCKING_QUEUE:
{
StgPtr end;
case WEAK:
{
StgWeak *w = (StgWeak *)p;
+ thread(&w->cfinalizer);
thread(&w->key);
thread(&w->value);
thread(&w->finalizer);
return p + sizeofW(StgMVar);
}
- case IND_OLDGEN:
- case IND_OLDGEN_PERM:
+ case IND:
+ case IND_PERM:
thread(&((StgInd *)p)->indirectee);
return p + sizeofW(StgInd);
case MUT_ARR_PTRS_FROZEN0:
// follow everything
{
- StgPtr next;
-
- next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ StgMutArrPtrs *a;
+
+ a = (StgMutArrPtrs *)p;
+ for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
thread((StgClosure **)p);
}
- return p;
+
+ return (StgPtr)a + mut_arr_ptrs_sizeW(a);
}
case TSO:
return thread_TSO((StgTSO *)p);
- case TVAR_WATCH_QUEUE:
- {
- StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
- thread_(&wq->closure);
- thread_(&wq->next_queue_entry);
- thread_(&wq->prev_queue_entry);
- return p + sizeofW(StgTVarWatchQueue);
- }
-
- case TVAR:
- {
- StgTVar *tvar = (StgTVar *)p;
- thread((void *)&tvar->current_value);
- thread((void *)&tvar->first_watch_queue_entry);
- return p + sizeofW(StgTVar);
- }
-
- case TREC_HEADER:
+ case STACK:
{
- StgTRecHeader *trec = (StgTRecHeader *)p;
- thread_(&trec->enclosing_trec);
- thread_(&trec->current_chunk);
- thread_(&trec->invariants_to_check);
- return p + sizeofW(StgTRecHeader);
+ StgStack *stack = (StgStack*)p;
+ thread_stack(stack->sp, stack->stack + stack->stack_size);
+ return p + stack_sizeW(stack);
}
case TREC_CHUNK:
return p + sizeofW(StgTRecChunk);
}
- case ATOMIC_INVARIANT:
- {
- StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
- thread_(&invariant->code);
- thread_(&invariant->last_execution);
- return p + sizeofW(StgAtomicInvariant);
- }
-
- case INVARIANT_CHECK_QUEUE:
- {
- StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
- thread_(&queue->invariant);
- thread_(&queue->my_execution);
- thread_(&queue->next_queue_entry);
- return p + sizeofW(StgInvariantCheckQueue);
- }
-
default:
barf("update_fwd: unknown/strange object %d", (int)(info->type));
return NULL;
size = p - q;
if (free + size > free_bd->start + BLOCK_SIZE_W) {
- // unset the next bit in the bitmap to indicate that
+ // set the next bit in the bitmap to indicate that
// this object needs to be pushed into the next
// block. This saves us having to run down the
// threaded info pointer list twice during the next pass.
- unmark(q+1,bd);
+ mark(q+1,bd);
free_bd = free_bd->link;
free = free_bd->start;
} else {
- ASSERT(is_marked(q+1,bd));
+ ASSERT(!is_marked(q+1,bd));
}
unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
}
static nat
-update_bkwd_compact( step *stp )
+update_bkwd_compact( generation *gen )
{
StgPtr p, free;
#if 0
nat size, free_blocks;
StgWord iptr;
- bd = free_bd = stp->old_blocks;
+ bd = free_bd = gen->old_blocks;
free = free_bd->start;
free_blocks = 1;
}
#endif
- if (!is_marked(p+1,bd)) {
+ if (is_marked(p+1,bd)) {
// don't forget to update the free ptr in the block desc.
free_bd->free = free;
free_bd = free_bd->link;
iptr = get_threaded_info(p);
unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
- ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
+ ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info));
info = get_itbl((StgClosure *)p);
size = closure_sizeW_((StgClosure *)p,info);
}
// relocate TSOs
- if (info->type == TSO) {
- move_TSO((StgTSO *)p, (StgTSO *)free);
+ if (info->type == STACK) {
+ move_STACK((StgStack *)p, (StgStack *)free);
}
free += size;
void
compact(StgClosure *static_objects)
{
- nat g, s, blocks;
- step *stp;
+ nat n, g, blocks;
+ generation *gen;
// 1. thread the roots
markCapabilities((evac_fn)thread_root, NULL);
for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
bdescr *bd;
StgPtr p;
- for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
- for (p = bd->start; p < bd->free; p++) {
- thread((StgClosure **)p);
- }
- }
+ for (n = 0; n < n_capabilities; n++) {
+ for (bd = capabilities[n].mut_lists[g];
+ bd != NULL; bd = bd->link) {
+ for (p = bd->start; p < bd->free; p++) {
+ thread((StgClosure **)p);
+ }
+ }
+ }
}
// the global thread list
- for (s = 0; s < total_steps; s++) {
- thread((void *)&all_steps[s].threads);
+ for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+ thread((void *)&generations[g].threads);
}
// any threads resurrected during this GC
thread((void *)&resurrected_threads);
- // the blackhole queue
- thread((void *)&blackhole_queue);
-
// the task list
{
Task *task;
+ InCall *incall;
for (task = all_tasks; task != NULL; task = task->all_link) {
- if (task->tso) {
- thread_(&task->tso);
- }
+ for (incall = task->incall; incall != NULL;
+ incall = incall->prev_stack) {
+ if (incall->tso) {
+ thread_(&incall->tso);
+ }
+ }
}
}
// 2. update forward ptrs
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- for (s = 0; s < generations[g].n_steps; s++) {
- if (g==0 && s ==0) continue;
- stp = &generations[g].steps[s];
- debugTrace(DEBUG_gc, "update_fwd: %d.%d",
- stp->gen->no, stp->no);
-
- update_fwd(stp->blocks);
- update_fwd_large(stp->scavenged_large_objects);
- if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
- debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
- stp->gen->no, stp->no);
- update_fwd_compact(stp->old_blocks);
- }
+ gen = &generations[g];
+ debugTrace(DEBUG_gc, "update_fwd: %d", g);
+
+ update_fwd(gen->blocks);
+ for (n = 0; n < n_capabilities; n++) {
+ update_fwd(gc_threads[n]->gens[g].todo_bd);
+ update_fwd(gc_threads[n]->gens[g].part_list);
+ }
+ update_fwd_large(gen->scavenged_large_objects);
+ if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
+ debugTrace(DEBUG_gc, "update_fwd: %d (compact)", g);
+ update_fwd_compact(gen->old_blocks);
}
}
// 3. update backward ptrs
- stp = &oldest_gen->steps[0];
- if (stp->old_blocks != NULL) {
- blocks = update_bkwd_compact(stp);
+ gen = oldest_gen;
+ if (gen->old_blocks != NULL) {
+ blocks = update_bkwd_compact(gen);
debugTrace(DEBUG_gc,
- "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
- stp->gen->no, stp->no,
- stp->n_old_blocks, blocks);
- stp->n_old_blocks = blocks;
+ "update_bkwd: %d (compact, old: %d blocks, now %d blocks)",
+ gen->no, gen->n_old_blocks, blocks);
+ gen->n_old_blocks = blocks;
}
}