void markCAFs (evac_fn evac, void *user) { StgIndStatic *c; for (c = dyn_caf_list; c != (StgIndStatic*)END_OF_CAF_LIST; c = (StgIndStatic *)c->static_link) { c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c); evac(user, &c->indirectee); } for (c = revertible_caf_list; c != (StgIndStatic*)END_OF_CAF_LIST; c = (StgIndStatic *)c->static_link) { c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c); evac(user, &c->indirectee); } }
void revertCAFs( void ) { StgIndStatic *c; for (c = revertible_caf_list; c != (StgIndStatic *)END_OF_CAF_LIST; c = (StgIndStatic *)c->static_link) { c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c); SET_INFO((StgClosure *)c, c->saved_info); c->saved_info = NULL; // could, but not necessary: c->static_link = NULL; } revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST; }
/* 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 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); }