/* ---------------------------------------------------------------------------- * Find the "closure identity", which is a unique pointer representing * the band to which this closure's heap space is attributed in the * heap profile. * ------------------------------------------------------------------------- */ static const void * closureIdentity( const StgClosure *p ) { switch (RtsFlags.ProfFlags.doHeapProfile) { #ifdef PROFILING case HEAP_BY_CCS: return p->header.prof.ccs; case HEAP_BY_MOD: return p->header.prof.ccs->cc->module; case HEAP_BY_DESCR: return GET_PROF_DESC(get_itbl(p)); case HEAP_BY_TYPE: return GET_PROF_TYPE(get_itbl(p)); case HEAP_BY_RETAINER: // AFAIK, the only closures in the heap which might not have a // valid retainer set are DEAD_WEAK closures. if (isRetainerSetFieldValid(p)) return retainerSetOf(p); else return NULL; #else case HEAP_BY_CLOSURE_TYPE: { const StgInfoTable *info; info = get_itbl(p); switch (info->type) { case CONSTR: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_2_0: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: return GET_CON_DESC(itbl_to_con_itbl(info)); default: return closure_type_names[info->type]; } } #endif default: barf("closureIdentity"); } }
/* * get at the real stuff...remove indirections. * It untags pointers before dereferencing and * retags the real stuff with its tag (if there * is any) when returning. * * ToDo: move to a better home. */ static StgClosure* removeIndirections(StgClosure* p) { StgWord tag = GET_CLOSURE_TAG(p); StgClosure* q = UNTAG_CLOSURE(p); while (get_itbl(q)->type == IND || get_itbl(q)->type == IND_STATIC || get_itbl(q)->type == IND_PERM) { q = ((StgInd *)q)->indirectee; tag = GET_CLOSURE_TAG(q); q = UNTAG_CLOSURE(q); } return TAG_CLOSURE(tag,q); }
static void update_fwd_large( bdescr *bd ) { StgPtr p; const StgInfoTable* info; for (; bd != NULL; bd = bd->link) { p = bd->start; info = get_itbl((StgClosure *)p); switch (info->type) { case ARR_WORDS: // nothing to follow continue; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: 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++) { thread((StgClosure **)p); } continue; } case TSO: thread_TSO((StgTSO *)p); continue; case AP_STACK: thread_AP_STACK((StgAP_STACK *)p); continue; case PAP: thread_PAP((StgPAP *)p); continue; default: barf("update_fwd_large: unknown/strange object %d", (int)(info->type)); } } }
static void printThunkPayload( StgThunk *obj ) { StgWord i, j; const StgInfoTable* info; info = get_itbl((StgClosure *)obj); for (i = 0; i < info->layout.payload.ptrs; ++i) { debugBelch(", "); printPtr((StgPtr)obj->payload[i]); } for (j = 0; j < info->layout.payload.nptrs; ++j) { debugBelch(", %pd#",obj->payload[i+j]); } debugBelch(")\n"); }
/* Check the static objects list. */ void checkStaticObjects ( StgClosure* static_objects ) { StgClosure *p = static_objects; const StgInfoTable *info; while (p != END_OF_STATIC_OBJECT_LIST) { p = UNTAG_STATIC_LIST_PTR(p); checkClosure(p); info = get_itbl(p); switch (info->type) { case IND_STATIC: { const StgClosure *indirectee; indirectee = UNTAG_CONST_CLOSURE(((StgIndStatic *)p)->indirectee); ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)indirectee->header.info)); p = *IND_STATIC_LINK((StgClosure *)p); break; } case THUNK_STATIC: p = *THUNK_STATIC_LINK((StgClosure *)p); break; case FUN_STATIC: p = *STATIC_LINK(info,(StgClosure *)p); break; case CONSTR: case CONSTR_NOCAF: case CONSTR_1_0: case CONSTR_2_0: case CONSTR_1_1: p = *STATIC_LINK(info,(StgClosure *)p); break; default: barf("checkStaticObjetcs: strange closure %p (%s)", p, info_type(p)); } } }
/* Check the static objects list. */ void checkStaticObjects ( StgClosure* static_objects ) { StgClosure *p = static_objects; StgInfoTable *info; while (p != END_OF_STATIC_LIST) { checkClosure(p); info = get_itbl(p); switch (info->type) { case IND_STATIC: { StgClosure *indirectee = UNTAG_CLOSURE(((StgIndStatic *)p)->indirectee); ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)indirectee->header.info)); p = *IND_STATIC_LINK((StgClosure *)p); break; } case THUNK_STATIC: p = *THUNK_STATIC_LINK((StgClosure *)p); break; case FUN_STATIC: p = *FUN_STATIC_LINK((StgClosure *)p); break; case CONSTR_STATIC: p = *STATIC_LINK(info,(StgClosure *)p); break; default: barf("checkStaticObjetcs: strange closure %p (%s)", p, #ifndef HaLVM_TARGET_OS info_type(p) #else "[HaLVM has no info_type()]" #endif ); } } }
/* Check that all TSOs have been evacuated. Optionally also check the sanity of the TSOs. */ void checkGlobalTSOList (rtsBool checkTSOs) { StgTSO *tso; nat g; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (tso=generations[g].threads; tso != END_TSO_QUEUE; tso = tso->global_link) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso)); ASSERT(get_itbl((StgClosure *)tso)->type == TSO); if (checkTSOs) checkTSO(tso); // If this TSO is dirty and in an old generation, it better // be on the mutable list. if (tso->dirty) { ASSERT(Bdescr((P_)tso)->gen_no == 0 || (tso->flags & TSO_MARKED)); tso->flags &= ~TSO_MARKED; } { StgStack *stack; StgUnderflowFrame *frame; stack = tso->stackobj; while (1) { if (stack->dirty & 1) { ASSERT(Bdescr((P_)stack)->gen_no == 0 || (stack->dirty & TSO_MARKED)); stack->dirty &= ~TSO_MARKED; } frame = (StgUnderflowFrame*) (stack->stack + stack->stack_size - sizeofW(StgUnderflowFrame)); if (frame->info != &stg_stack_underflow_frame_info || frame->next_chunk == (StgStack*)END_TSO_QUEUE) break; stack = frame->next_chunk; } } } } }
static void update_fwd( bdescr *blocks ) { StgPtr p; bdescr *bd; StgInfoTable *info; bd = blocks; // cycle through all the blocks in the step for (; bd != NULL; bd = bd->link) { p = bd->start; // linearly scan the objects in this block while (p < bd->free) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); p = thread_obj(info, p); } } }
static void checkMutableList( bdescr *mut_bd, nat gen ) { bdescr *bd; StgPtr q; StgClosure *p; for (bd = mut_bd; bd != NULL; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { p = (StgClosure *)*q; ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen); checkClosure(p); switch (get_itbl(p)->type) { case TSO: ((StgTSO *)p)->flags |= TSO_MARKED; break; case STACK: ((StgStack *)p)->dirty |= TSO_MARKED; break; } } } }
STATIC_INLINE void evacuate_large(StgPtr p) { bdescr *bd; generation *gen, *new_gen; nat gen_no, new_gen_no; gen_workspace *ws; bd = Bdescr(p); gen = bd->gen; gen_no = bd->gen_no; ACQUIRE_SPIN_LOCK(&gen->sync); // already evacuated? if (bd->flags & BF_EVACUATED) { /* Don't forget to set the gct->failed_to_evac flag if we didn't get * the desired destination (see comments in evacuate()). */ if (gen_no < gct->evac_gen_no) { gct->failed_to_evac = rtsTrue; TICK_GC_FAILED_PROMOTION(); } RELEASE_SPIN_LOCK(&gen->sync); return; } // remove from large_object list if (bd->u.back) { bd->u.back->link = bd->link; } else { // first object in the list gen->large_objects = bd->link; } if (bd->link) { bd->link->u.back = bd->u.back; } /* link it on to the evacuated large object list of the destination gen */ new_gen_no = bd->dest_no; if (new_gen_no < gct->evac_gen_no) { if (gct->eager_promotion) { new_gen_no = gct->evac_gen_no; } else { gct->failed_to_evac = rtsTrue; } } ws = &gct->gens[new_gen_no]; new_gen = &generations[new_gen_no]; bd->flags |= BF_EVACUATED; initBdescr(bd, new_gen, new_gen->to); // If this is a block of pinned objects, we don't have to scan // these objects, because they aren't allowed to contain any // pointers. For these blocks, we skip the scavenge stage and put // them straight on the scavenged_large_objects list. if (bd->flags & BF_PINNED) { ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS); if (new_gen != gen) { ACQUIRE_SPIN_LOCK(&new_gen->sync); } dbl_link_onto(bd, &new_gen->scavenged_large_objects); new_gen->n_scavenged_large_blocks += bd->blocks; if (new_gen != gen) { RELEASE_SPIN_LOCK(&new_gen->sync); } } else { bd->link = ws->todo_large_objects; ws->todo_large_objects = bd; } RELEASE_SPIN_LOCK(&gen->sync); }
static void verify_consistency_block (StgCompactNFData *str, StgCompactNFDataBlock *block) { bdescr *bd; StgPtr p; const StgInfoTable *info; StgClosure *q; p = (P_)firstBlockGetCompact(block); bd = Bdescr((P_)block); while (p < bd->free) { q = (StgClosure*)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); info = get_itbl(q); switch (info->type) { case CONSTR_1_0: check_object_in_compact(str, UNTAG_CLOSURE(q->payload[0])); /* fallthrough */ case CONSTR_0_1: p += sizeofW(StgClosure) + 1; break; case CONSTR_2_0: check_object_in_compact(str, UNTAG_CLOSURE(q->payload[1])); /* fallthrough */ case CONSTR_1_1: check_object_in_compact(str, UNTAG_CLOSURE(q->payload[0])); /* fallthrough */ case CONSTR_0_2: p += sizeofW(StgClosure) + 2; break; case CONSTR: case PRIM: case CONSTR_NOCAF: { uint32_t i; for (i = 0; i < info->layout.payload.ptrs; i++) { check_object_in_compact(str, UNTAG_CLOSURE(q->payload[i])); } p += sizeofW(StgClosure) + info->layout.payload.ptrs + info->layout.payload.nptrs; break; } case ARR_WORDS: p += arr_words_sizeW((StgArrBytes*)p); break; case MUT_ARR_PTRS_FROZEN_CLEAN: case MUT_ARR_PTRS_FROZEN_DIRTY: verify_mut_arr_ptrs(str, (StgMutArrPtrs*)p); p += mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); break; case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: { uint32_t i; StgSmallMutArrPtrs *arr = (StgSmallMutArrPtrs*)p; for (i = 0; i < arr->ptrs; i++) check_object_in_compact(str, UNTAG_CLOSURE(arr->payload[i])); p += sizeofW(StgSmallMutArrPtrs) + arr->ptrs; break; } case COMPACT_NFDATA: p += sizeofW(StgCompactNFData); break; default: barf("verify_consistency_block"); } } return; }
static void searchHeapBlocks (HashTable *addrs, bdescr *bd) { StgPtr p; StgInfoTable *info; nat size; rtsBool prim; for (; bd != NULL; bd = bd->link) { if (bd->flags & BF_PINNED) { // Assume that objects in PINNED blocks cannot refer to continue; } p = bd->start; while (p < bd->free) { info = get_itbl((StgClosure *)p); prim = rtsFalse; switch (info->type) { case THUNK: size = thunk_sizeW_fromITBL(info); break; case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: size = sizeofW(StgThunkHeader) + 2; break; case THUNK_1_0: case THUNK_0_1: case THUNK_SELECTOR: size = sizeofW(StgThunkHeader) + 1; break; case CONSTR: case FUN: case FUN_1_0: case FUN_0_1: case FUN_1_1: case FUN_0_2: case FUN_2_0: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: size = sizeW_fromITBL(info); break; case BLACKHOLE: case BLOCKING_QUEUE: prim = rtsTrue; size = sizeW_fromITBL(info); break; case IND: // Special case/Delicate Hack: INDs don't normally // appear, since we're doing this heap census right // after GC. However, GarbageCollect() also does // resurrectThreads(), which can update some // blackholes when it calls raiseAsync() on the // resurrected threads. So we know that any IND will // be the size of a BLACKHOLE. prim = rtsTrue; size = BLACKHOLE_sizeW(); break; case BCO: prim = rtsTrue; size = bco_sizeW((StgBCO *)p); break; case MVAR_CLEAN: case MVAR_DIRTY: case TVAR: case WEAK: case PRIM: case MUT_PRIM: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: prim = rtsTrue; size = sizeW_fromITBL(info); break; case AP: prim = rtsTrue; size = ap_sizeW((StgAP *)p); break; case PAP: prim = rtsTrue; size = pap_sizeW((StgPAP *)p); break; case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; prim = rtsTrue; size = ap_stack_sizeW(ap); searchStackChunk(addrs, (StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); break; } case ARR_WORDS: prim = rtsTrue; size = arr_words_sizeW((StgArrBytes*)p); break; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: prim = rtsTrue; size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p); break; case SMALL_MUT_ARR_PTRS_CLEAN: case SMALL_MUT_ARR_PTRS_DIRTY: case SMALL_MUT_ARR_PTRS_FROZEN: case SMALL_MUT_ARR_PTRS_FROZEN0: prim = rtsTrue; size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p); break; case TSO: prim = rtsTrue; size = sizeofW(StgTSO); break; case STACK: { StgStack *stack = (StgStack*)p; prim = rtsTrue; searchStackChunk(addrs, stack->sp, stack->stack + stack->stack_size); size = stack_sizeW(stack); break; } case TREC_CHUNK: prim = rtsTrue; size = sizeofW(StgTRecChunk); break; default: barf("heapCensus, unknown object: %d", info->type); } if (!prim) { checkAddress(addrs,info); } p += size; } } }
// // Check whether we can unload any object code. This is called at the // appropriate point during a GC, where all the heap data is nice and // packed together and we have a linked list of the static objects. // // The check involves a complete heap traversal, but you only pay for // this (a) when you have called unloadObj(), and (b) at a major GC, // which is much more expensive than the traversal we're doing here. // void checkUnload (StgClosure *static_objects) { nat g, n; HashTable *addrs; StgClosure* p; const StgInfoTable *info; ObjectCode *oc, *prev, *next; gen_workspace *ws; StgClosure* link; if (unloaded_objects == NULL) return; ACQUIRE_LOCK(&linker_unloaded_mutex); // Mark every unloadable object as unreferenced initially for (oc = unloaded_objects; oc; oc = oc->next) { IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", oc->fileName)); oc->referenced = rtsFalse; } addrs = allocHashTable(); for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) { p = UNTAG_STATIC_LIST_PTR(p); checkAddress(addrs, p); info = get_itbl(p); link = *STATIC_LINK(info, p); } // CAFs on revertible_caf_list are not on static_objects for (p = (StgClosure*)revertible_caf_list; p != END_OF_CAF_LIST; p = ((StgIndStatic *)p)->static_link) { p = UNTAG_STATIC_LIST_PTR(p); checkAddress(addrs, p); } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { searchHeapBlocks (addrs, generations[g].blocks); searchHeapBlocks (addrs, generations[g].large_objects); for (n = 0; n < n_capabilities; n++) { ws = &gc_threads[n]->gens[g]; searchHeapBlocks(addrs, ws->todo_bd); searchHeapBlocks(addrs, ws->part_list); searchHeapBlocks(addrs, ws->scavd_list); } } #ifdef PROFILING /* Traverse the cost centre tree, calling checkAddress on each CCS/CC */ searchCostCentres(addrs, CCS_MAIN); /* Also check each cost centre in the CC_LIST */ CostCentre *cc; for (cc = CC_LIST; cc != NULL; cc = cc->link) { checkAddress(addrs, cc); } #endif /* PROFILING */ // Look through the unloadable objects, and any object that is still // marked as unreferenced can be physically unloaded, because we // have no references to it. prev = NULL; for (oc = unloaded_objects; oc; oc = next) { next = oc->next; if (oc->referenced == 0) { if (prev == NULL) { unloaded_objects = oc->next; } else { prev->next = oc->next; } IF_DEBUG(linker, debugBelch("Unloading object file %" PATH_FMT "\n", oc->fileName)); freeObjectCode(oc); } else { IF_DEBUG(linker, debugBelch("Object file still in use: %" PATH_FMT "\n", oc->fileName)); prev = oc; } } freeHashTable(addrs, NULL); RELEASE_LOCK(&linker_unloaded_mutex); }
nat throwToMsg (Capability *cap, MessageThrowTo *msg) { StgWord status; StgTSO *target = msg->target; Capability *target_cap; goto check_target; retry: write_barrier(); debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: ASSERT(target != END_TSO_QUEUE); // Thread already dead? if (target->what_next == ThreadComplete || target->what_next == ThreadKilled) { return THROWTO_SUCCESS; } debugTraceCap(DEBUG_sched, cap, "throwTo: from thread %lu to thread %lu", (unsigned long)msg->source->id, (unsigned long)msg->target->id); #ifdef DEBUG traceThreadStatus(DEBUG_sched, target); #endif target_cap = target->cap; if (target->cap != cap) { throwToSendMsg(cap, target_cap, msg); return THROWTO_BLOCKED; } status = target->why_blocked; switch (status) { case NotBlocked: { if ((target->flags & TSO_BLOCKEX) == 0) { // It's on our run queue and not blocking exceptions raiseAsync(cap, target, msg->exception, rtsFalse, NULL); return THROWTO_SUCCESS; } else { blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; } } case BlockedOnMsgThrowTo: { const StgInfoTable *i; MessageThrowTo *m; m = target->block_info.throwto; // target is local to this cap, but has sent a throwto // message to another cap. // // The source message is locked. We need to revoke the // target's message so that we can raise the exception, so // we attempt to lock it. // There's a possibility of a deadlock if two threads are both // trying to throwTo each other (or more generally, a cycle of // threads). To break the symmetry we compare the addresses // of the MessageThrowTo objects, and the one for which m < // msg gets to spin, while the other can only try to lock // once, but must then back off and unlock both before trying // again. if (m < msg) { i = lockClosure((StgClosure *)m); } else { i = tryLockClosure((StgClosure *)m); if (i == NULL) { // debugBelch("collision\n"); throwToSendMsg(cap, target->cap, msg); return THROWTO_BLOCKED; } } if (i == &stg_MSG_NULL_info) { // we know there's a MSG_TRY_WAKEUP on the way, so we // might as well just do it now. The message will // be a no-op when it arrives. unlockClosure((StgClosure*)m, i); tryWakeupThread(cap, target); goto retry; } if (i != &stg_MSG_THROWTO_info) { // if it's a MSG_NULL, this TSO has been woken up by another Cap unlockClosure((StgClosure*)m, i); goto retry; } if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { unlockClosure((StgClosure*)m, i); blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; } // nobody else can wake up this TSO after we claim the message doneWithMsgThrowTo(m); raiseAsync(cap, target, msg->exception, rtsFalse, NULL); return THROWTO_SUCCESS; } case BlockedOnMVar: case BlockedOnMVarRead: { /* To establish ownership of this TSO, we need to acquire a lock on the MVar that it is blocked on. */ StgMVar *mvar; StgInfoTable *info USED_IF_THREADS; mvar = (StgMVar *)target->block_info.closure; // ASSUMPTION: tso->block_info must always point to a // closure. In the threaded RTS it does. switch (get_itbl((StgClosure *)mvar)->type) { case MVAR_CLEAN: case MVAR_DIRTY: break; default: goto retry; } info = lockClosure((StgClosure *)mvar); // we have the MVar, let's check whether the thread // is still blocked on the same MVar. if ((target->why_blocked != BlockedOnMVar && target->why_blocked != BlockedOnMVarRead) || (StgMVar *)target->block_info.closure != mvar) { unlockClosure((StgClosure *)mvar, info); goto retry; } if (target->_link == END_TSO_QUEUE) { // the MVar operation has already completed. There is a // MSG_TRY_WAKEUP on the way, but we can just wake up the // thread now anyway and ignore the message when it // arrives. unlockClosure((StgClosure *)mvar, info); tryWakeupThread(cap, target); goto retry; } if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { blockedThrowTo(cap,target,msg); unlockClosure((StgClosure *)mvar, info); return THROWTO_BLOCKED; } else { // revoke the MVar operation removeFromMVarBlockedQueue(target); raiseAsync(cap, target, msg->exception, rtsFalse, NULL); unlockClosure((StgClosure *)mvar, info); return THROWTO_SUCCESS; } } case BlockedOnBlackHole: { if (target->flags & TSO_BLOCKEX) { // BlockedOnBlackHole is not interruptible. blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; } else { // Revoke the message by replacing it with IND. We're not // locking anything here, so we might still get a TRY_WAKEUP // message from the owner of the blackhole some time in the // future, but that doesn't matter. ASSERT(target->block_info.bh->header.info == &stg_MSG_BLACKHOLE_info); OVERWRITE_INFO(target->block_info.bh, &stg_IND_info); raiseAsync(cap, target, msg->exception, rtsFalse, NULL); return THROWTO_SUCCESS; } } case BlockedOnSTM: lockTSO(target); // Unblocking BlockedOnSTM threads requires the TSO to be // locked; see STM.c:unpark_tso(). if (target->why_blocked != BlockedOnSTM) { unlockTSO(target); goto retry; } if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { blockedThrowTo(cap,target,msg); unlockTSO(target); return THROWTO_BLOCKED; } else { raiseAsync(cap, target, msg->exception, rtsFalse, NULL); unlockTSO(target); return THROWTO_SUCCESS; } case BlockedOnCCall_Interruptible: #ifdef THREADED_RTS { Task *task = NULL; // walk suspended_ccalls to find the correct worker thread InCall *incall; for (incall = cap->suspended_ccalls; incall != NULL; incall = incall->next) { if (incall->suspended_tso == target) { task = incall->task; break; } } if (task != NULL) { blockedThrowTo(cap, target, msg); if (!((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0))) { interruptWorkerTask(task); } return THROWTO_BLOCKED; } else { debugTraceCap(DEBUG_sched, cap, "throwTo: could not find worker thread to kill"); } // fall to next } #endif case BlockedOnCCall: blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; #ifndef THREADEDED_RTS case BlockedOnRead: case BlockedOnWrite: case BlockedOnDelay: #if defined(mingw32_HOST_OS) case BlockedOnDoProc: #endif if ((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0)) { blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; } else { removeFromQueues(cap,target); raiseAsync(cap, target, msg->exception, rtsFalse, NULL); return THROWTO_SUCCESS; } #endif case ThreadMigrating: // if is is ThreadMigrating and tso->cap is ours, then it // *must* be migrating *to* this capability. If it were // migrating away from the capability, then tso->cap would // point to the destination. // // There is a MSG_WAKEUP in the message queue for this thread, // but we can just do it preemptively: tryWakeupThread(cap, target); // and now retry, the thread should be runnable. goto retry; default: barf("throwTo: unrecognised why_blocked (%d)", target->why_blocked); } barf("throwTo"); }
void prettyPrintClosure_ (StgClosure *obj) { StgInfoTable *info; StgConInfoTable *con_info; /* collapse any indirections */ unsigned int type; type = get_itbl(obj)->type; while (type == IND || type == IND_STATIC || type == IND_PERM) { obj = ((StgInd *)obj)->indirectee; type = get_itbl(obj)->type; } /* find the info table for this object */ info = get_itbl(obj); /* determine what kind of object we have */ switch (info->type) { /* full applications of data constructors */ case CONSTR: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: { nat i; char *descriptor; /* find the con_info for the constructor */ con_info = get_con_itbl (obj); /* obtain the name of the constructor */ descriptor = GET_CON_DESC(con_info); debugBelch ("(%s", descriptor); /* process the payload of the closure */ /* we don't handle non pointers at the moment */ for (i = 0; i < info->layout.payload.ptrs; i++) { debugBelch (" "); prettyPrintClosure_ ((StgClosure *) obj->payload[i]); } debugBelch (")"); break; } /* if it isn't a constructor then just print the closure type */ default: { debugBelch ("<%s>", info_type(obj)); break; } } }
StgOffset checkClosure( StgClosure* p ) { const StgInfoTable *info; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); p = UNTAG_CLOSURE(p); /* Is it a static closure (i.e. in the data segment)? */ if (!HEAP_ALLOCED(p)) { ASSERT(closure_STATIC(p)); } else { ASSERT(!closure_STATIC(p)); } info = p->header.info; if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); } info = INFO_PTR_TO_STRUCT(info); switch (info->type) { case MVAR_CLEAN: case MVAR_DIRTY: { StgMVar *mvar = (StgMVar *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value)); return sizeofW(StgMVar); } case THUNK: case THUNK_1_0: case THUNK_0_1: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: { nat i; for (i = 0; i < info->layout.payload.ptrs; i++) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i])); } return thunk_sizeW_fromITBL(info); } case FUN: case FUN_1_0: case FUN_0_1: case FUN_1_1: case FUN_0_2: case FUN_2_0: case CONSTR: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: case IND_PERM: case BLACKHOLE: case PRIM: case MUT_PRIM: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: case THUNK_STATIC: case FUN_STATIC: { nat i; for (i = 0; i < info->layout.payload.ptrs; i++) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i])); } return sizeW_fromITBL(info); } case BLOCKING_QUEUE: { StgBlockingQueue *bq = (StgBlockingQueue *)p; // NO: the BH might have been updated now // ASSERT(get_itbl(bq->bh)->type == BLACKHOLE); ASSERT(LOOKS_LIKE_CLOSURE_PTR(bq->bh)); ASSERT(get_itbl((StgClosure *)(bq->owner))->type == TSO); ASSERT(bq->queue == (MessageBlackHole*)END_TSO_QUEUE || bq->queue->header.info == &stg_MSG_BLACKHOLE_info); ASSERT(bq->link == (StgBlockingQueue*)END_TSO_QUEUE || get_itbl((StgClosure *)(bq->link))->type == IND || get_itbl((StgClosure *)(bq->link))->type == BLOCKING_QUEUE); return sizeofW(StgBlockingQueue); } case BCO: { StgBCO *bco = (StgBCO *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs)); return bco_sizeW(bco); } case IND_STATIC: /* (1, 0) closure */ ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgIndStatic*)p)->indirectee)); return sizeW_fromITBL(info); case WEAK: /* deal with these specially - the info table isn't * representative of the actual layout. */ { StgWeak *w = (StgWeak *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); if (w->link) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link)); } return sizeW_fromITBL(info); } case THUNK_SELECTOR: ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee)); return THUNK_SELECTOR_sizeW(); case IND: { /* we don't expect to see any of these after GC * but they might appear during execution */ StgInd *ind = (StgInd *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee)); return sizeofW(StgInd); } case RET_BCO: case RET_SMALL: case RET_BIG: case RET_DYN: case UPDATE_FRAME: case UNDERFLOW_FRAME: case STOP_FRAME: case CATCH_FRAME: case ATOMICALLY_FRAME: case CATCH_RETRY_FRAME: case CATCH_STM_FRAME: barf("checkClosure: stack frame"); case AP: { StgAP* ap = (StgAP *)p; checkPAP (ap->fun, ap->payload, ap->n_args); return ap_sizeW(ap); } case PAP: { StgPAP* pap = (StgPAP *)p; checkPAP (pap->fun, pap->payload, pap->n_args); return pap_sizeW(pap); } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(ap->fun)); checkStackChunk((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); return ap_stack_sizeW(ap); } case ARR_WORDS: return arr_words_sizeW((StgArrWords *)p); case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: { StgMutArrPtrs* a = (StgMutArrPtrs *)p; nat i; for (i = 0; i < a->ptrs; i++) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i])); } return mut_arr_ptrs_sizeW(a); } case TSO: checkTSO((StgTSO *)p); return sizeofW(StgTSO); case STACK: checkSTACK((StgStack*)p); return stack_sizeW((StgStack*)p); case TREC_CHUNK: { nat i; StgTRecChunk *tc = (StgTRecChunk *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->prev_chunk)); for (i = 0; i < tc -> next_entry_idx; i ++) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].tvar)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].expected_value)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].new_value)); } return sizeofW(StgTRecChunk); } default: barf("checkClosure (closure type %d)", info->type); } }
static void scavenge_stack(StgPtr p, StgPtr stack_end) { const StgRetInfoTable* info; StgWord bitmap; nat size; /* * Each time around this loop, we are looking at a chunk of stack * that starts with an activation record. */ while (p < stack_end) { info = get_ret_itbl((StgClosure *)p); switch (info->i.type) { case UPDATE_FRAME: // In SMP, we can get update frames that point to indirections // when two threads evaluate the same thunk. We do attempt to // discover this situation in threadPaused(), but it's // possible that the following sequence occurs: // // A B // enter T // enter T // blackhole T // update T // GC // // Now T is an indirection, and the update frame is already // marked on A's stack, so we won't traverse it again in // threadPaused(). We could traverse the whole stack again // before GC, but that seems like overkill. // // Scavenging this update frame as normal would be disastrous; // the updatee would end up pointing to the value. So we // check whether the value after evacuation is a BLACKHOLE, // and if not, we change the update frame to an stg_enter // frame that simply returns the value. Hence, blackholing is // compulsory (otherwise we would have to check for thunks // too). // // Note [upd-black-hole] // One slight hiccup is that the THUNK_SELECTOR machinery can // overwrite the updatee with an IND. In parallel GC, this // could even be happening concurrently, so we can't check for // the IND. Fortunately if we assume that blackholing is // happening (either lazy or eager), then we can be sure that // the updatee is never a THUNK_SELECTOR and we're ok. // NB. this is a new invariant: blackholing is not optional. { StgUpdateFrame *frame = (StgUpdateFrame *)p; StgClosure *v; evacuate(&frame->updatee); v = frame->updatee; if (GET_CLOSURE_TAG(v) != 0 || (get_itbl(v)->type != BLACKHOLE)) { // blackholing is compulsory, see above. frame->header.info = (const StgInfoTable*)&stg_enter_checkbh_info; } ASSERT(v->header.info != &stg_TSO_info); p += sizeofW(StgUpdateFrame); continue; } // small bitmap (< 32 entries, or 64 on a 64-bit machine) case CATCH_STM_FRAME: case CATCH_RETRY_FRAME: case ATOMICALLY_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); // NOTE: the payload starts immediately after the info-ptr, we // don't have an StgHeader in the same sense as a heap closure. p++; p = scavenge_small_bitmap(p, size, bitmap); follow_srt: if (major_gc) scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap); continue; case RET_BCO: { StgBCO *bco; nat size; p++; evacuate((StgClosure **)p); bco = (StgBCO *)*p; p++; size = BCO_BITMAP_SIZE(bco); scavenge_large_bitmap(p, BCO_BITMAP(bco), size); p += size; continue; } // large bitmap (> 32 entries, or > 64 on a 64-bit machine) case RET_BIG: { nat size; size = GET_LARGE_BITMAP(&info->i)->size; p++; scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size); p += size; // and don't forget to follow the SRT goto follow_srt; } // Dynamic bitmap: the mask is stored on the stack, and // there are a number of non-pointers followed by a number // of pointers above the bitmapped area. (see StgMacros.h, // HEAP_CHK_GEN). case RET_DYN: { StgWord dyn; dyn = ((StgRetDyn *)p)->liveness; // traverse the bitmap first bitmap = RET_DYN_LIVENESS(dyn); p = (P_)&((StgRetDyn *)p)->payload[0]; size = RET_DYN_BITMAP_SIZE; p = scavenge_small_bitmap(p, size, bitmap); // skip over the non-ptr words p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; // follow the ptr words for (size = RET_DYN_PTRS(dyn); size > 0; size--) { evacuate((StgClosure **)p); p++; } continue; } case RET_FUN: { StgRetFun *ret_fun = (StgRetFun *)p; StgFunInfoTable *fun_info; evacuate(&ret_fun->fun); fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); p = scavenge_arg_block(fun_info, ret_fun->payload); goto follow_srt; } default: barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type)); } } }
void printStackChunk( StgPtr sp, StgPtr spBottom ) { StgWord bitmap; const StgInfoTable *info; ASSERT(sp <= spBottom); for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) { info = get_itbl((StgClosure *)sp); switch (info->type) { case UPDATE_FRAME: case CATCH_FRAME: case UNDERFLOW_FRAME: case STOP_FRAME: printClosure((StgClosure*)sp); continue; case RET_SMALL: { StgWord c = *sp; if (c == (StgWord)&stg_ctoi_R1p_info) { debugBelch("tstg_ctoi_ret_R1p_info\n" ); } else if (c == (StgWord)&stg_ctoi_R1n_info) { debugBelch("stg_ctoi_ret_R1n_info\n" ); } else if (c == (StgWord)&stg_ctoi_F1_info) { debugBelch("stg_ctoi_ret_F1_info\n" ); } else if (c == (StgWord)&stg_ctoi_D1_info) { debugBelch("stg_ctoi_ret_D1_info\n" ); } else if (c == (StgWord)&stg_ctoi_V_info) { debugBelch("stg_ctoi_ret_V_info\n" ); } else if (c == (StgWord)&stg_ap_v_info) { debugBelch("stg_ap_v_info\n" ); } else if (c == (StgWord)&stg_ap_f_info) { debugBelch("stg_ap_f_info\n" ); } else if (c == (StgWord)&stg_ap_d_info) { debugBelch("stg_ap_d_info\n" ); } else if (c == (StgWord)&stg_ap_l_info) { debugBelch("stg_ap_l_info\n" ); } else if (c == (StgWord)&stg_ap_n_info) { debugBelch("stg_ap_n_info\n" ); } else if (c == (StgWord)&stg_ap_p_info) { debugBelch("stg_ap_p_info\n" ); } else if (c == (StgWord)&stg_ap_pp_info) { debugBelch("stg_ap_pp_info\n" ); } else if (c == (StgWord)&stg_ap_ppp_info) { debugBelch("stg_ap_ppp_info\n" ); } else if (c == (StgWord)&stg_ap_pppp_info) { debugBelch("stg_ap_pppp_info\n" ); } else if (c == (StgWord)&stg_ap_ppppp_info) { debugBelch("stg_ap_ppppp_info\n" ); } else if (c == (StgWord)&stg_ap_pppppp_info) { debugBelch("stg_ap_pppppp_info\n" ); #ifdef PROFILING } else if (c == (StgWord)&stg_restore_cccs_info) { debugBelch("stg_restore_cccs_info\n" ); fprintCCS(stderr, (CostCentreStack*)sp[1]); debugBelch("\n" ); continue; #endif } else { debugBelch("RET_SMALL (%p)\n", info); } bitmap = info->layout.bitmap; printSmallBitmap(spBottom, sp+1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap)); continue; } case RET_BCO: { StgBCO *bco; bco = ((StgBCO *)sp[1]); debugBelch("RET_BCO (%p)\n", sp); printLargeBitmap(spBottom, sp+2, BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco)); continue; } case RET_BIG: barf("todo"); case RET_FUN: { const StgFunInfoTable *fun_info; StgRetFun *ret_fun; ret_fun = (StgRetFun *)sp; fun_info = get_fun_itbl(ret_fun->fun); debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type); switch (fun_info->f.fun_type) { case ARG_GEN: printSmallBitmap(spBottom, sp+2, BITMAP_BITS(fun_info->f.b.bitmap), BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: printLargeBitmap(spBottom, sp+2, GET_FUN_LARGE_BITMAP(fun_info), GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: printSmallBitmap(spBottom, sp+2, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; } continue; } default: debugBelch("unknown object %d\n", (int)info->type); barf("printStackChunk"); } } }
const char * info_type(const StgClosure *closure){ return closure_type_names[get_itbl(closure)->type]; }
static rtsBool scavenge_one(StgPtr p) { const StgInfoTable *info; rtsBool no_luck; rtsBool saved_eager_promotion; saved_eager_promotion = gct->eager_promotion; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); switch (info->type) { case MVAR_CLEAN: case MVAR_DIRTY: { StgMVar *mvar = ((StgMVar *)p); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&mvar->head); evacuate((StgClosure **)&mvar->tail); evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { mvar->header.info = &stg_MVAR_CLEAN_info; } break; } case THUNK: case THUNK_1_0: case THUNK_0_1: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: { StgPtr q, end; end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs; for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) { evacuate((StgClosure **)q); } break; } case FUN: case FUN_1_0: // hardly worth specialising these guys case FUN_0_1: case FUN_1_1: case FUN_0_2: case FUN_2_0: case CONSTR: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: case WEAK: case PRIM: case IND_PERM: { StgPtr q, end; end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) { evacuate((StgClosure **)q); } break; } case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: { StgPtr q = p; gct->eager_promotion = rtsFalse; evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; } break; } case BLOCKING_QUEUE: { StgBlockingQueue *bq = (StgBlockingQueue *)p; gct->eager_promotion = rtsFalse; evacuate(&bq->bh); evacuate((StgClosure**)&bq->owner); evacuate((StgClosure**)&bq->queue); evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; } break; } case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; evacuate(&s->selectee); break; } case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; evacuate(&ap->fun); scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); p = (StgPtr)ap->payload + ap->size; break; } case PAP: p = scavenge_PAP((StgPAP *)p); break; case AP: p = scavenge_AP((StgAP *)p); break; case ARR_WORDS: // nothing to follow break; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: { // We don't eagerly promote objects pointed to by a mutable // array, but if we find the array only points to objects in // the same or an older generation, we mark it "clean" and // avoid traversing it during minor GCs. gct->eager_promotion = rtsFalse; scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; break; } case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: { // follow everything scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); // If we're going to put this object on the mutable list, then // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; } else { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; } break; } case TSO: { scavengeTSO((StgTSO*)p); break; } case STACK: { StgStack *stack = (StgStack*)p; gct->eager_promotion = rtsFalse; scavenge_stack(stack->sp, stack->stack + stack->stack_size); stack->dirty = gct->failed_to_evac; gct->eager_promotion = saved_eager_promotion; break; } case MUT_PRIM: { StgPtr end; gct->eager_promotion = rtsFalse; end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable break; } case TREC_CHUNK: { StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable break; } case IND: // IND can happen, for example, when the interpreter allocates // a gigantic AP closure (more than one block), which ends up // on the large-object list and then gets updated. See #3424. case BLACKHOLE: case IND_STATIC: evacuate(&((StgInd *)p)->indirectee); #if 0 && defined(DEBUG) if (RtsFlags.DebugFlags.gc) /* Debugging code to print out the size of the thing we just * promoted */ { StgPtr start = gen->scan; bdescr *start_bd = gen->scan_bd; nat size = 0; scavenge(&gen); if (start_bd != gen->scan_bd) { size += (P_)BLOCK_ROUND_UP(start) - start; start_bd = start_bd->link; while (start_bd != gen->scan_bd) { size += BLOCK_SIZE_W; start_bd = start_bd->link; } size += gen->scan - (P_)BLOCK_ROUND_DOWN(gen->scan); } else { size = gen->scan - start; } debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); } #endif break; default: barf("scavenge_one: strange object %d", (int)(info->type)); } no_luck = gct->failed_to_evac; gct->failed_to_evac = rtsFalse; return (no_luck); }
void scavenge_mutable_list(bdescr *bd, generation *gen) { StgPtr p, q; nat gen_no; gen_no = gen->no; gct->evac_gen_no = gen_no; for (; bd != NULL; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { p = (StgPtr)*q; ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); #ifdef DEBUG switch (get_itbl((StgClosure *)p)->type) { case MUT_VAR_CLEAN: // can happen due to concurrent writeMutVars case MUT_VAR_DIRTY: mutlist_MUTVARS++; break; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: mutlist_MUTARRS++; break; case MVAR_CLEAN: barf("MVAR_CLEAN on mutable list"); case MVAR_DIRTY: mutlist_MVARS++; break; default: mutlist_OTHERS++; break; } #endif // Check whether this object is "clean", that is it // definitely doesn't point into a young generation. // Clean objects don't need to be scavenged. Some clean // objects (MUT_VAR_CLEAN) are not kept on the mutable // list at all; others, such as TSO // are always on the mutable list. // switch (get_itbl((StgClosure *)p)->type) { case MUT_ARR_PTRS_CLEAN: recordMutableGen_GC((StgClosure *)p,gen_no); continue; case MUT_ARR_PTRS_DIRTY: { rtsBool saved_eager_promotion; saved_eager_promotion = gct->eager_promotion; gct->eager_promotion = rtsFalse; scavenge_mut_arr_ptrs_marked((StgMutArrPtrs *)p); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsFalse; recordMutableGen_GC((StgClosure *)p,gen_no); continue; } default: ; } if (scavenge_one(p)) { // didn't manage to promote everything, so put the // object back on the list. recordMutableGen_GC((StgClosure *)p,gen_no); } } } }
static GNUC_ATTR_HOT void scavenge_block (bdescr *bd) { StgPtr p, q; StgInfoTable *info; rtsBool saved_eager_promotion; gen_workspace *ws; debugTrace(DEBUG_gc, "scavenging block %p (gen %d) @ %p", bd->start, bd->gen_no, bd->u.scan); gct->scan_bd = bd; gct->evac_gen_no = bd->gen_no; saved_eager_promotion = gct->eager_promotion; gct->failed_to_evac = rtsFalse; ws = &gct->gens[bd->gen->no]; p = bd->u.scan; // we might be evacuating into the very object that we're // scavenging, so we have to check the real bd->free pointer each // time around the loop. while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) { ASSERT(bd->link == NULL); ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); ASSERT(gct->thunk_selector_depth == 0); q = p; switch (info->type) { case MVAR_CLEAN: case MVAR_DIRTY: { StgMVar *mvar = ((StgMVar *)p); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&mvar->head); evacuate((StgClosure **)&mvar->tail); evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { mvar->header.info = &stg_MVAR_CLEAN_info; } p += sizeofW(StgMVar); break; } case FUN_2_0: scavenge_fun_srt(info); evacuate(&((StgClosure *)p)->payload[1]); evacuate(&((StgClosure *)p)->payload[0]); p += sizeofW(StgHeader) + 2; break; case THUNK_2_0: scavenge_thunk_srt(info); evacuate(&((StgThunk *)p)->payload[1]); evacuate(&((StgThunk *)p)->payload[0]); p += sizeofW(StgThunk) + 2; break; case CONSTR_2_0: evacuate(&((StgClosure *)p)->payload[1]); evacuate(&((StgClosure *)p)->payload[0]); p += sizeofW(StgHeader) + 2; break; case THUNK_1_0: scavenge_thunk_srt(info); evacuate(&((StgThunk *)p)->payload[0]); p += sizeofW(StgThunk) + 1; break; case FUN_1_0: scavenge_fun_srt(info); case CONSTR_1_0: evacuate(&((StgClosure *)p)->payload[0]); p += sizeofW(StgHeader) + 1; break; case THUNK_0_1: scavenge_thunk_srt(info); p += sizeofW(StgThunk) + 1; break; case FUN_0_1: scavenge_fun_srt(info); case CONSTR_0_1: p += sizeofW(StgHeader) + 1; break; case THUNK_0_2: scavenge_thunk_srt(info); p += sizeofW(StgThunk) + 2; break; case FUN_0_2: scavenge_fun_srt(info); case CONSTR_0_2: p += sizeofW(StgHeader) + 2; break; case THUNK_1_1: scavenge_thunk_srt(info); evacuate(&((StgThunk *)p)->payload[0]); p += sizeofW(StgThunk) + 2; break; case FUN_1_1: scavenge_fun_srt(info); case CONSTR_1_1: evacuate(&((StgClosure *)p)->payload[0]); p += sizeofW(StgHeader) + 2; break; case FUN: scavenge_fun_srt(info); goto gen_obj; case THUNK: { StgPtr end; scavenge_thunk_srt(info); end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } p += info->layout.payload.nptrs; break; } gen_obj: case CONSTR: case WEAK: case PRIM: { StgPtr end; end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } p += info->layout.payload.nptrs; break; } case BCO: { StgBCO *bco = (StgBCO *)p; evacuate((StgClosure **)&bco->instrs); evacuate((StgClosure **)&bco->literals); evacuate((StgClosure **)&bco->ptrs); p += bco_sizeW(bco); break; } case IND_PERM: case BLACKHOLE: evacuate(&((StgInd *)p)->indirectee); p += sizeofW(StgInd); break; case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: gct->eager_promotion = rtsFalse; evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; } p += sizeofW(StgMutVar); break; case BLOCKING_QUEUE: { StgBlockingQueue *bq = (StgBlockingQueue *)p; gct->eager_promotion = rtsFalse; evacuate(&bq->bh); evacuate((StgClosure**)&bq->owner); evacuate((StgClosure**)&bq->queue); evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; } p += sizeofW(StgBlockingQueue); break; } case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; evacuate(&s->selectee); p += THUNK_SELECTOR_sizeW(); break; } // A chunk of stack saved in a heap object case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; evacuate(&ap->fun); scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); p = (StgPtr)ap->payload + ap->size; break; } case PAP: p = scavenge_PAP((StgPAP *)p); break; case AP: p = scavenge_AP((StgAP *)p); break; case ARR_WORDS: // nothing to follow p += arr_words_sizeW((StgArrWords *)p); break; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: { // We don't eagerly promote objects pointed to by a mutable // array, but if we find the array only points to objects in // the same or an older generation, we mark it "clean" and // avoid traversing it during minor GCs. gct->eager_promotion = rtsFalse; p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // always put it on the mutable list. break; } case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: // follow everything { p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); // If we're going to put this object on the mutable list, then // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; } break; } case TSO: { scavengeTSO((StgTSO *)p); p += sizeofW(StgTSO); break; } case STACK: { StgStack *stack = (StgStack*)p; gct->eager_promotion = rtsFalse; scavenge_stack(stack->sp, stack->stack + stack->stack_size); stack->dirty = gct->failed_to_evac; p += stack_sizeW(stack); gct->eager_promotion = saved_eager_promotion; break; } case MUT_PRIM: { StgPtr end; gct->eager_promotion = rtsFalse; end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } p += info->layout.payload.nptrs; gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable break; } case TREC_CHUNK: { StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecChunk); break; } default: barf("scavenge: unimplemented/strange closure type %d @ %p", info->type, p); } /* * We need to record the current object on the mutable list if * (a) It is actually mutable, or * (b) It contains pointers to a younger generation. * Case (b) arises if we didn't manage to promote everything that * the current object points to into the current generation. */ if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; if (bd->gen_no > 0) { recordMutableGen_GC((StgClosure *)q, bd->gen_no); } } } if (p > bd->free) { gct->copied += ws->todo_free - bd->free; bd->free = p; } debugTrace(DEBUG_gc, " scavenged %ld bytes", (unsigned long)((bd->free - bd->u.scan) * sizeof(W_))); // update stats: this is a block that has been scavenged gct->scanned += bd->free - bd->u.scan; bd->u.scan = bd->free; if (bd != ws->todo_bd) { // we're not going to evac any more objects into // this block, so push it now. push_scanned_block(bd, ws); } gct->scan_bd = NULL; }
REGPARM1 GNUC_ATTR_HOT void evacuate(StgClosure **p) { bdescr *bd = NULL; nat gen_no; StgClosure *q; const StgInfoTable *info; StgWord tag; q = *p; loop: /* The tag and the pointer are split, to be merged after evacing */ tag = GET_CLOSURE_TAG(q); q = UNTAG_CLOSURE(q); ASSERTM(LOOKS_LIKE_CLOSURE_PTR(q), "invalid closure, info=%p", q->header.info); if (!HEAP_ALLOCED_GC(q)) { if (!major_gc) return; info = get_itbl(q); switch (info->type) { case THUNK_STATIC: if (info->srt_bitmap != 0) { evacuate_static_object(THUNK_STATIC_LINK((StgClosure *)q), q); } return; case FUN_STATIC: if (info->srt_bitmap != 0) { evacuate_static_object(FUN_STATIC_LINK((StgClosure *)q), q); } return; case IND_STATIC: /* If q->saved_info != NULL, then it's a revertible CAF - it'll be * on the CAF list, so don't do anything with it here (we'll * scavenge it later). */ evacuate_static_object(IND_STATIC_LINK((StgClosure *)q), q); return; case CONSTR_STATIC: evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q); return; case CONSTR_NOCAF_STATIC: /* no need to put these on the static linked list, they don't need * to be scavenged. */ return; default: barf("evacuate(static): strange closure type %d", (int)(info->type)); } } bd = Bdescr((P_)q); if ((bd->flags & (BF_LARGE | BF_MARKED | BF_EVACUATED)) != 0) { // pointer into to-space: just return it. It might be a pointer // into a generation that we aren't collecting (> N), or it // might just be a pointer into to-space. The latter doesn't // happen often, but allowing it makes certain things a bit // easier; e.g. scavenging an object is idempotent, so it's OK to // have an object on the mutable list multiple times. if (bd->flags & BF_EVACUATED) { // We aren't copying this object, so we have to check // whether it is already in the target generation. (this is // the write barrier). if (bd->gen_no < gct->evac_gen_no) { gct->failed_to_evac = rtsTrue; TICK_GC_FAILED_PROMOTION(); } return; } /* evacuate large objects by re-linking them onto a different list. */ if (bd->flags & BF_LARGE) { evacuate_large((P_)q); return; } /* If the object is in a gen that we're compacting, then we * need to use an alternative evacuate procedure. */ if (!is_marked((P_)q,bd)) { mark((P_)q,bd); push_mark_stack((P_)q); } return; } gen_no = bd->dest_no; info = q->header.info; if (IS_FORWARDING_PTR(info)) { /* Already evacuated, just return the forwarding address. * HOWEVER: if the requested destination generation (gct->evac_gen) is * older than the actual generation (because the object was * already evacuated to a younger generation) then we have to * set the gct->failed_to_evac flag to indicate that we couldn't * manage to promote the object to the desired generation. */ /* * Optimisation: the check is fairly expensive, but we can often * shortcut it if either the required generation is 0, or the * current object (the EVACUATED) is in a high enough generation. * We know that an EVACUATED always points to an object in the * same or an older generation. gen is the lowest generation that the * current object would be evacuated to, so we only do the full * check if gen is too low. */ StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info); *p = TAG_CLOSURE(tag,e); if (gen_no < gct->evac_gen_no) { // optimisation if (Bdescr((P_)e)->gen_no < gct->evac_gen_no) { gct->failed_to_evac = rtsTrue; TICK_GC_FAILED_PROMOTION(); } } return; } switch (INFO_PTR_TO_STRUCT(info)->type) { case WHITEHOLE: goto loop; // For ints and chars of low value, save space by replacing references to // these with closures with references to common, shared ones in the RTS. // // * Except when compiling into Windows DLLs which don't support cross-package // data references very well. // case CONSTR_0_1: { #if defined(COMPILING_WINDOWS_DLL) copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag); #else StgWord w = (StgWord)q->payload[0]; if (info == Czh_con_info && // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && (StgChar)w <= MAX_CHARLIKE) { *p = TAG_CLOSURE(tag, (StgClosure *)CHARLIKE_CLOSURE((StgChar)w) ); } else if (info == Izh_con_info && (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) { *p = TAG_CLOSURE(tag, (StgClosure *)INTLIKE_CLOSURE((StgInt)w) ); } else { copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag); } #endif return; } case FUN_0_1: case FUN_1_0: case CONSTR_1_0: copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag); return; case THUNK_1_0: case THUNK_0_1: copy(p,info,q,sizeofW(StgThunk)+1,gen_no); return; case THUNK_1_1: case THUNK_2_0: case THUNK_0_2: #ifdef NO_PROMOTE_THUNKS #error bitrotted #endif copy(p,info,q,sizeofW(StgThunk)+2,gen_no); return; case FUN_1_1: case FUN_2_0: case FUN_0_2: case CONSTR_1_1: case CONSTR_2_0: copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag); return; case CONSTR_0_2: copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag); return; case THUNK: copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no); return; case FUN: case CONSTR: copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no,tag); return; case BLACKHOLE: { StgClosure *r; const StgInfoTable *i; r = ((StgInd*)q)->indirectee; if (GET_CLOSURE_TAG(r) == 0) { i = r->header.info; if (IS_FORWARDING_PTR(i)) { r = (StgClosure *)UN_FORWARDING_PTR(i); i = r->header.info; } if (i == &stg_TSO_info || i == &stg_WHITEHOLE_info || i == &stg_BLOCKING_QUEUE_CLEAN_info || i == &stg_BLOCKING_QUEUE_DIRTY_info) { copy(p,info,q,sizeofW(StgInd),gen_no); return; } ASSERT(i != &stg_IND_info); } q = r; *p = r; goto loop; } case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case MVAR_CLEAN: case MVAR_DIRTY: case TVAR: case BLOCKING_QUEUE: case WEAK: case PRIM: case MUT_PRIM: copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no); return; case BCO: copy(p,info,q,bco_sizeW((StgBCO *)q),gen_no); return; case THUNK_SELECTOR: eval_thunk_selector(p, (StgSelector *)q, rtsTrue); return; case IND: // follow chains of indirections, don't evacuate them q = ((StgInd*)q)->indirectee; *p = q; goto loop; case RET_BCO: case RET_SMALL: case RET_BIG: case UPDATE_FRAME: case UNDERFLOW_FRAME: case STOP_FRAME: case CATCH_FRAME: case CATCH_STM_FRAME: case CATCH_RETRY_FRAME: case ATOMICALLY_FRAME: // shouldn't see these barf("evacuate: stack frame at %p\n", q); case PAP: copy(p,info,q,pap_sizeW((StgPAP*)q),gen_no); return; case AP: copy(p,info,q,ap_sizeW((StgAP*)q),gen_no); return; case AP_STACK: copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),gen_no); return; case ARR_WORDS: // just copy the block copy(p,info,q,arr_words_sizeW((StgArrBytes *)q),gen_no); return; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: // just copy the block copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen_no); return; case SMALL_MUT_ARR_PTRS_CLEAN: case SMALL_MUT_ARR_PTRS_DIRTY: case SMALL_MUT_ARR_PTRS_FROZEN: case SMALL_MUT_ARR_PTRS_FROZEN0: // just copy the block copy(p,info,q,small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)q),gen_no); return; case TSO: copy(p,info,q,sizeofW(StgTSO),gen_no); return; case STACK: { StgStack *stack = (StgStack *)q; /* To evacuate a small STACK, we need to adjust the stack pointer */ { StgStack *new_stack; StgPtr r, s; rtsBool mine; mine = copyPart(p,(StgClosure *)stack, stack_sizeW(stack), sizeofW(StgStack), gen_no); if (mine) { new_stack = (StgStack *)*p; move_STACK(stack, new_stack); for (r = stack->sp, s = new_stack->sp; r < stack->stack + stack->stack_size;) { *s++ = *r++; } } return; } } case TREC_CHUNK: copy(p,info,q,sizeofW(StgTRecChunk),gen_no); return; default: barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type)); } barf("evacuate"); }
void printStackChunk( StgPtr sp, StgPtr spBottom ) { StgWord bitmap; const StgInfoTable *info; ASSERT(sp <= spBottom); for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) { info = get_itbl((StgClosure *)sp); switch (info->type) { case UPDATE_FRAME: case CATCH_FRAME: case UNDERFLOW_FRAME: case STOP_FRAME: printObj((StgClosure*)sp); continue; case RET_DYN: { StgRetDyn* r; StgPtr p; StgWord dyn; nat size; r = (StgRetDyn *)sp; dyn = r->liveness; debugBelch("RET_DYN (%p)\n", r); p = (P_)(r->payload); printSmallBitmap(spBottom, sp, RET_DYN_LIVENESS(r->liveness), RET_DYN_BITMAP_SIZE); p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE; for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) { debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p); debugBelch("Word# %ld\n", (long)*p); p++; } for (size = RET_DYN_PTRS(dyn); size > 0; size--) { debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p); printPtr(p); p++; } continue; } case RET_SMALL: debugBelch("RET_SMALL (%p)\n", info); bitmap = info->layout.bitmap; printSmallBitmap(spBottom, sp+1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap)); continue; case RET_BCO: { StgBCO *bco; bco = ((StgBCO *)sp[1]); debugBelch("RET_BCO (%p)\n", sp); printLargeBitmap(spBottom, sp+2, BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco)); continue; } case RET_BIG: barf("todo"); case RET_FUN: { StgFunInfoTable *fun_info; StgRetFun *ret_fun; ret_fun = (StgRetFun *)sp; fun_info = get_fun_itbl(ret_fun->fun); debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type); switch (fun_info->f.fun_type) { case ARG_GEN: printSmallBitmap(spBottom, sp+2, BITMAP_BITS(fun_info->f.b.bitmap), BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: printLargeBitmap(spBottom, sp+2, GET_FUN_LARGE_BITMAP(fun_info), GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: printSmallBitmap(spBottom, sp+2, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; } continue; } default: debugBelch("unknown object %d\n", (int)info->type); barf("printStackChunk"); } } }
void printClosure( const StgClosure *obj ) { const StgInfoTable *info; obj = UNTAG_CONST_CLOSURE(obj); info = get_itbl(obj); switch ( info->type ) { case INVALID_OBJECT: barf("Invalid object"); case CONSTR: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: { StgWord i, j; const StgConInfoTable *con_info = get_con_itbl (obj); debugBelch("%s(", GET_CON_DESC(con_info)); for (i = 0; i < info->layout.payload.ptrs; ++i) { if (i != 0) debugBelch(", "); printPtr((StgPtr)obj->payload[i]); } for (j = 0; j < info->layout.payload.nptrs; ++j) { if (i != 0 || j != 0) debugBelch(", "); debugBelch("%p#", obj->payload[i+j]); } debugBelch(")\n"); break; } case FUN: case FUN_1_0: case FUN_0_1: case FUN_1_1: case FUN_0_2: case FUN_2_0: case FUN_STATIC: debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity); printPtr((StgPtr)obj->header.info); #ifdef PROFILING debugBelch(", %s", obj->header.prof.ccs->cc->label); #endif printStdObjPayload(obj); break; case PRIM: debugBelch("PRIM("); printPtr((StgPtr)obj->header.info); printStdObjPayload(obj); break; case MUT_PRIM: debugBelch("MUT_PRIM("); printPtr((StgPtr)obj->header.info); printStdObjPayload(obj); break; case THUNK: case THUNK_1_0: case THUNK_0_1: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: case THUNK_STATIC: /* ToDo: will this work for THUNK_STATIC too? */ #ifdef PROFILING printThunkObject((StgThunk *)obj,GET_PROF_DESC(info)); #else printThunkObject((StgThunk *)obj,"THUNK"); #endif break; case THUNK_SELECTOR: printStdObjHdr(obj, "THUNK_SELECTOR"); debugBelch(", %p)\n", ((StgSelector *)obj)->selectee); break; case BCO: disassemble( (StgBCO*)obj ); break; case AP: { StgAP* ap = (StgAP*)obj; StgWord i; debugBelch("AP("); printPtr((StgPtr)ap->fun); for (i = 0; i < ap->n_args; ++i) { debugBelch(", "); printPtr((P_)ap->payload[i]); } debugBelch(")\n"); break; } case PAP: { StgPAP* pap = (StgPAP*)obj; StgWord i; debugBelch("PAP/%d(",(int)pap->arity); printPtr((StgPtr)pap->fun); for (i = 0; i < pap->n_args; ++i) { debugBelch(", "); printPtr((StgPtr)pap->payload[i]); } debugBelch(")\n"); break; } case AP_STACK: { StgAP_STACK* ap = (StgAP_STACK*)obj; StgWord i; debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun); for (i = 0; i < ap->size; ++i) { debugBelch(", "); printPtr((P_)ap->payload[i]); } debugBelch(")\n"); break; } case IND: debugBelch("IND("); printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case IND_STATIC: debugBelch("IND_STATIC("); printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case BLACKHOLE: debugBelch("BLACKHOLE("); printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; /* Cannot happen -- use default case. case RET_BCO: case RET_SMALL: case RET_BIG: case RET_FUN: */ case UPDATE_FRAME: { StgUpdateFrame* u = (StgUpdateFrame*)obj; debugBelch("%s(", info_update_frame(obj)); printPtr((StgPtr)GET_INFO((StgClosure *)u)); debugBelch(","); printPtr((StgPtr)u->updatee); debugBelch(")\n"); break; } case CATCH_FRAME: { StgCatchFrame* u = (StgCatchFrame*)obj; debugBelch("CATCH_FRAME("); printPtr((StgPtr)GET_INFO((StgClosure *)u)); debugBelch(","); printPtr((StgPtr)u->handler); debugBelch(")\n"); break; } case UNDERFLOW_FRAME: { StgUnderflowFrame* u = (StgUnderflowFrame*)obj; debugBelch("UNDERFLOW_FRAME("); printPtr((StgPtr)u->next_chunk); debugBelch(")\n"); break; } case STOP_FRAME: { StgStopFrame* u = (StgStopFrame*)obj; debugBelch("STOP_FRAME("); printPtr((StgPtr)GET_INFO((StgClosure *)u)); debugBelch(")\n"); break; } case ARR_WORDS: { StgWord i; debugBelch("ARR_WORDS(\""); for (i=0; i<arr_words_words((StgArrBytes *)obj); i++) debugBelch("%" FMT_Word, (W_)((StgArrBytes *)obj)->payload[i]); debugBelch("\")\n"); break; } case MUT_ARR_PTRS_CLEAN: debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs); break; case MUT_ARR_PTRS_DIRTY: debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs); break; case MUT_ARR_PTRS_FROZEN: debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs); break; case SMALL_MUT_ARR_PTRS_CLEAN: debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgSmallMutArrPtrs *)obj)->ptrs); break; case SMALL_MUT_ARR_PTRS_DIRTY: debugBelch("SMALL_MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgSmallMutArrPtrs *)obj)->ptrs); break; case SMALL_MUT_ARR_PTRS_FROZEN: debugBelch("SMALL_MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgSmallMutArrPtrs *)obj)->ptrs); break; case MVAR_CLEAN: case MVAR_DIRTY: { StgMVar* mv = (StgMVar*)obj; debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value); break; } case TVAR: { StgTVar* tv = (StgTVar*)obj; debugBelch("TVAR(value=%p, wq=%p, num_updates=%" FMT_Word ")\n", tv->current_value, tv->first_watch_queue_entry, tv->num_updates); break; } case MUT_VAR_CLEAN: { StgMutVar* mv = (StgMutVar*)obj; debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var); break; } case MUT_VAR_DIRTY: { StgMutVar* mv = (StgMutVar*)obj; debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var); break; } case WEAK: debugBelch("WEAK("); debugBelch(" key=%p value=%p finalizer=%p", (StgPtr)(((StgWeak*)obj)->key), (StgPtr)(((StgWeak*)obj)->value), (StgPtr)(((StgWeak*)obj)->finalizer)); debugBelch(")\n"); /* ToDo: chase 'link' ? */ break; case TSO: debugBelch("TSO("); debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj); debugBelch(")\n"); break; case STACK: debugBelch("STACK"); break; #if 0 /* Symptomatic of a problem elsewhere, have it fall-through & fail */ case EVACUATED: debugBelch("EVACUATED("); printClosure((StgEvacuated*)obj->evacuee); debugBelch(")\n"); break; #endif case COMPACT_NFDATA: debugBelch("COMPACT_NFDATA(size=%" FMT_Word ")\n", (W_)((StgCompactNFData *)obj)->totalDataW * sizeof(W_)); break; default: //barf("printClosure %d",get_itbl(obj)->type); debugBelch("*** printClosure: unknown type %d ****\n", (int)get_itbl(obj)->type ); barf("printClosure %d",get_itbl(obj)->type); return; } }
static void scavenge_mark_stack(void) { StgPtr p, q; StgInfoTable *info; rtsBool saved_eager_promotion; gct->evac_gen_no = oldest_gen->no; saved_eager_promotion = gct->eager_promotion; while ((p = pop_mark_stack())) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl((StgClosure *)p); q = p; switch (info->type) { case MVAR_CLEAN: case MVAR_DIRTY: { StgMVar *mvar = ((StgMVar *)p); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&mvar->head); evacuate((StgClosure **)&mvar->tail); evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { mvar->header.info = &stg_MVAR_CLEAN_info; } break; } case FUN_2_0: scavenge_fun_srt(info); evacuate(&((StgClosure *)p)->payload[1]); evacuate(&((StgClosure *)p)->payload[0]); break; case THUNK_2_0: scavenge_thunk_srt(info); evacuate(&((StgThunk *)p)->payload[1]); evacuate(&((StgThunk *)p)->payload[0]); break; case CONSTR_2_0: evacuate(&((StgClosure *)p)->payload[1]); evacuate(&((StgClosure *)p)->payload[0]); break; case FUN_1_0: case FUN_1_1: scavenge_fun_srt(info); evacuate(&((StgClosure *)p)->payload[0]); break; case THUNK_1_0: case THUNK_1_1: scavenge_thunk_srt(info); evacuate(&((StgThunk *)p)->payload[0]); break; case CONSTR_1_0: case CONSTR_1_1: evacuate(&((StgClosure *)p)->payload[0]); break; case FUN_0_1: case FUN_0_2: scavenge_fun_srt(info); break; case THUNK_0_1: case THUNK_0_2: scavenge_thunk_srt(info); break; case CONSTR_0_1: case CONSTR_0_2: break; case FUN: scavenge_fun_srt(info); goto gen_obj; case THUNK: { StgPtr end; scavenge_thunk_srt(info); end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } break; } gen_obj: case CONSTR: case WEAK: case PRIM: { StgPtr end; end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } break; } case BCO: { StgBCO *bco = (StgBCO *)p; evacuate((StgClosure **)&bco->instrs); evacuate((StgClosure **)&bco->literals); evacuate((StgClosure **)&bco->ptrs); break; } case IND_PERM: // don't need to do anything here: the only possible case // is that we're in a 1-space compacting collector, with // no "old" generation. break; case IND: case BLACKHOLE: evacuate(&((StgInd *)p)->indirectee); break; case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: { gct->eager_promotion = rtsFalse; evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; } break; } case BLOCKING_QUEUE: { StgBlockingQueue *bq = (StgBlockingQueue *)p; gct->eager_promotion = rtsFalse; evacuate(&bq->bh); evacuate((StgClosure**)&bq->owner); evacuate((StgClosure**)&bq->queue); evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info; } break; } case ARR_WORDS: break; case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; evacuate(&s->selectee); break; } // A chunk of stack saved in a heap object case AP_STACK: { StgAP_STACK *ap = (StgAP_STACK *)p; evacuate(&ap->fun); scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); break; } case PAP: scavenge_PAP((StgPAP *)p); break; case AP: scavenge_AP((StgAP *)p); break; case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: // follow everything { // We don't eagerly promote objects pointed to by a mutable // array, but if we find the array only points to objects in // the same or an older generation, we mark it "clean" and // avoid traversing it during minor GCs. gct->eager_promotion = rtsFalse; scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable anyhow. break; } case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr q = p; scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); // If we're going to put this object on the mutable list, then // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; } else { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; } break; } case TSO: { scavengeTSO((StgTSO*)p); break; } case STACK: { StgStack *stack = (StgStack*)p; gct->eager_promotion = rtsFalse; scavenge_stack(stack->sp, stack->stack + stack->stack_size); stack->dirty = gct->failed_to_evac; gct->eager_promotion = saved_eager_promotion; break; } case MUT_PRIM: { StgPtr end; gct->eager_promotion = rtsFalse; end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { evacuate((StgClosure **)p); } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable break; } case TREC_CHUNK: { StgWord i; StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); gct->eager_promotion = rtsFalse; evacuate((StgClosure **)&tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { evacuate((StgClosure **)&e->tvar); evacuate((StgClosure **)&e->expected_value); evacuate((StgClosure **)&e->new_value); } gct->eager_promotion = saved_eager_promotion; gct->failed_to_evac = rtsTrue; // mutable break; } default: barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", info->type, p); } if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; if (gct->evac_gen_no) { recordMutableGen_GC((StgClosure *)q, gct->evac_gen_no); } } } // while (p = pop_mark_stack()) }
// // Check whether we can unload any object code. This is called at the // appropriate point during a GC, where all the heap data is nice and // packed together and we have a linked list of the static objects. // // The check involves a complete heap traversal, but you only pay for // this (a) when you have called unloadObj(), and (b) at a major GC, // which is much more expensive than the traversal we're doing here. // void checkUnload (StgClosure *static_objects) { nat g, n; HashTable *addrs; StgClosure* p; const StgInfoTable *info; ObjectCode *oc, *prev, *next; gen_workspace *ws; StgClosure* link; if (unloaded_objects == NULL) return; // Mark every unloadable object as unreferenced initially for (oc = unloaded_objects; oc; oc = oc->next) { IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", oc->fileName)); oc->referenced = rtsFalse; } addrs = allocHashTable(); for (p = static_objects; p != END_OF_STATIC_LIST; p = link) { checkAddress(addrs, p); info = get_itbl(p); link = *STATIC_LINK(info, p); } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { searchHeapBlocks (addrs, generations[g].blocks); searchHeapBlocks (addrs, generations[g].large_objects); for (n = 0; n < n_capabilities; n++) { ws = &gc_threads[n]->gens[g]; searchHeapBlocks(addrs, ws->todo_bd); searchHeapBlocks(addrs, ws->part_list); searchHeapBlocks(addrs, ws->scavd_list); } } // Look through the unloadable objects, and any object that is still // marked as unreferenced can be physically unloaded, because we // have no references to it. prev = NULL; for (oc = unloaded_objects; oc; prev = oc, oc = next) { next = oc->next; if (oc->referenced == 0) { if (prev == NULL) { unloaded_objects = oc->next; } else { prev->next = oc->next; } IF_DEBUG(linker, debugBelch("Unloading object file %" PATH_FMT "\n", oc->fileName)); freeObjectCode(oc); } else { IF_DEBUG(linker, debugBelch("Object file still in use: %" PATH_FMT "\n", oc->fileName)); } } freeHashTable(addrs, NULL); }
static void scavenge_static(void) { StgClosure* p; const StgInfoTable *info; debugTrace(DEBUG_gc, "scavenging static objects"); /* Always evacuate straight to the oldest generation for static * objects */ gct->evac_gen_no = oldest_gen->no; /* keep going until we've scavenged all the objects on the linked list... */ while (1) { /* get the next static object from the list. Remember, there might * be more stuff on this list after each evacuation... * (static_objects is a global) */ p = gct->static_objects; if (p == END_OF_STATIC_LIST) { break; } ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); info = get_itbl(p); /* if (info->type==RBH) info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure */ // make sure the info pointer is into text space /* Take this object *off* the static_objects list, * and put it on the scavenged_static_objects list. */ gct->static_objects = *STATIC_LINK(info,p); *STATIC_LINK(info,p) = gct->scavenged_static_objects; gct->scavenged_static_objects = p; switch (info -> type) { case IND_STATIC: { StgInd *ind = (StgInd *)p; evacuate(&ind->indirectee); /* might fail to evacuate it, in which case we have to pop it * back on the mutable list of the oldest generation. We * leave it *on* the scavenged_static_objects list, though, * in case we visit this object again. */ if (gct->failed_to_evac) { gct->failed_to_evac = rtsFalse; recordMutableGen_GC((StgClosure *)p,oldest_gen->no); } break; } case THUNK_STATIC: scavenge_thunk_srt(info); break; case FUN_STATIC: scavenge_fun_srt(info); break; case CONSTR_STATIC: { StgPtr q, next; next = (P_)p->payload + info->layout.payload.ptrs; // evacuate the pointers for (q = (P_)p->payload; q < next; q++) { evacuate((StgClosure **)q); } break; } default: barf("scavenge_static: strange closure %d", (int)(info->type)); } ASSERT(gct->failed_to_evac == rtsFalse); } }
void info_hdr_type(const StgClosure *closure, char *res){ strcpy(res,closure_type_names[get_itbl(closure)->type]); }
static nat update_bkwd_compact( step *stp ) { StgPtr p, free; #if 0 StgWord m; #endif bdescr *bd, *free_bd; StgInfoTable *info; nat size, free_blocks; StgWord iptr; bd = free_bd = stp->old_blocks; free = free_bd->start; free_blocks = 1; // cycle through all the blocks in the step for (; bd != NULL; bd = bd->link) { p = bd->start; while (p < bd->free ) { while ( p < bd->free && !is_marked(p,bd) ) { p++; } if (p >= bd->free) { break; } #if 0 next: m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord)))); m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1)); while ( p < bd->free ) { if ((m & 1) == 0) { m >>= 1; p++; if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) { goto next; } else { continue; } } #endif 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; free = free_bd->start; free_blocks++; } iptr = get_threaded_info(p); unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info)); info = get_itbl((StgClosure *)p); size = closure_sizeW_((StgClosure *)p,info); if (free != p) { move(free,p,size); } // relocate TSOs if (info->type == TSO) { move_TSO((StgTSO *)p, (StgTSO *)free); } free += size; p += size; #if 0 goto next; #endif } } // free the remaining blocks and count what's left. free_bd->free = free; if (free_bd->link != NULL) { freeChain(free_bd->link); free_bd->link = NULL; } return free_blocks; }