/* --------------------------------------------------------------------------- Time-stamp: $Id: Global.c,v 1.15 2009/12/09 18:31:10 hwloidl Exp $ (c) The AQUA/Parade Projects, Glasgow University, 1995 The GdH/APART 624 Projects, Heriot-Watt University, Edinburgh, 1999 Global Address Manipulation. The GALA and LAGA tables for mapping global addresses to local addresses (i.e. heap pointers) are defined here. We use the generic hash tables defined in Hash.c. ------------------------------------------------------------------------- */ #if defined(PARALLEL_RTS) //@menu //* Includes:: //* Global tables and lists:: //* Fcts on GALA tables:: //* Interface to taskId-PE table:: //* Interface to LAGA table:: //* Interface to GALA table:: //* GC functions for GALA tables:: //* Index:: //@end menu //*/ //@node Includes, Global tables and lists, Global Address Manipulation, Global Address Manipulation //@subsection Includes #include "Rts.h" #include "RtsFlags.h" #include "RtsUtils.h" #include "sm/Storage.h" #include "Hash.h" #include "HLC.h" #include "ParallelRts.h" // TODO: merge this .h file with others #include "ParallelDebug.h" #if defined(DEBUG) # include "sm/Sanity.h" # include "ParallelDebug.h" #endif /* @globalAddr@ structures are allocated in chunks to reduce malloc overhead. */ //@node Global tables and lists, Fcts on GALA tables, Includes, Global Address Manipulation //@subsection Global tables and lists //@menu //* Free lists:: //* Hash tables:: //@end menu //@node Free lists, Hash tables, Global tables and lists, Global tables and lists //@subsubsection Free lists /* Free list of GALA entries */ GALA *freeGALAList = NULL; /* Number of globalAddr cells to allocate in one go */ #define GCHUNK (1024 * sizeof(StgWord) / sizeof(GALA)) // original is 1024 mustafa on 10/6/2011 /* Free list of indirections */ //@cindex nextIndirection static StgInt nextIndirection = 0; //@cindex freeIndirections GALA *freeIndirections = NULL; /* The list of in-ptrs, i.e. the targets of inter-processor pointers. These must be roots to the GC, because the existence of an in-ptr indicates that we have pointer to the GA. This was the live indirections list in pre-merge GUM. */ //@cindex inPtrs GALA *inPtrs = NULL; /* The list of out-ptrs, i.e. sources of inter-processor pointers. These are NOT roots to the GC. If a closure, associated with a GA on this list, becomes garbage, a free message is sent to the other end of the inter-processor ptr. There the closure can be GCed, if it holds the full weight of the GA (i.e. no ptrs from other PEs to this GA exist) and the closure is not needed locally either. This is checked in the rebuildGALAtable function. This was the remote indirections list in pre-merge GUM. */ //@cindex outPtrs GALA *outPtrs = NULL; /* The list of GAs for which we received a fetch request; no LA needed! */ //@cindex blockedFetches GALA *blockedFetches = NULL; //@node Hash tables, , Free lists, Global tables and lists //@subsubsection Hash tables /* Mapping global task ids PEs */ //@cindex taskIDtoPEtable // HashTable *taskIDtoPEtable = NULL; static int nextPE = 0; /* LAGA table: StgClosure* -> globalAddr* (Remember: globalAddr = (PeId, Slot, Weight)) Mapping local to global addresses (see interface below) */ //@cindex LAtoGALAtable HashTable *LAtoGALAtable = NULL; /* GALA table: globalAddr* -> StgClosure* (Remember: globalAddr = (PeId, Slot, Weight)) Mapping global to local addresses (see interface below) */ //@cindex pGAtoGALAtable HashTable *pGAtoGALAtable = NULL; // prototypes StgWord PackGA (StgWord pe ,int slot); nat rebuildGALAlist(GALA **list_rootP, rtsBool freeGAs); // ----------------------------------------------------------------------------- //@node Fcts on GALA tables, Interface to taskId-PE table, Global tables and lists, Global Address Manipulation //@subsection Fcts on GALA tables StgInt highest_slot (void); //@cindex allocGALA static GALA * allocGALA(void) { GALA *gl, *p; if ((gl = freeGALAList) != NULL) { IF_DEBUG(sanity, ASSERT(gl->ga.weight==0xdead0add); ASSERT(gl->la==(StgPtr)0xdead00aa)); freeGALAList = gl->next; } else { gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA"); freeGALAList = gl + 1; for (p = freeGALAList; p < gl + GCHUNK - 1; p++) { p->next = p + 1; IF_DEBUG(sanity, p->ga.weight=0xdead0add; p->la=(StgPtr)0xdead00aa); } /* last elem in the new block has NULL pointer in link field */ p->next = NULL; IF_DEBUG(sanity, p->ga.weight=0xdead0add; p->la=(StgPtr)0xdead00aa); } IF_DEBUG(sanity, gl->ga.weight=0xdead0add; gl->la=(StgPtr)0xdead00aa); return gl; } void deallocGALA(GALA *bf_gc) { IF_DEBUG(sanity, { bf_gc->ga.weight=0xdead0add; bf_gc->la=(StgPtr)0xdead00aa;};); bf_gc->next = freeGALAList; freeGALAList = bf_gc; } //@node Interface to LAGA table, Interface to GALA table, Interface to taskId-PE table, Global Address Manipulation //@subsection Interface to LAGA table /* The local address to global address mapping returns a globalAddr structure (pe task id, slot, weight) for any closure in the local heap which has a global identity. Such closures may be copies of normal form objects with a remote `master' location, @FetchMe@ nodes referencing remote objects, or globally visible objects in the local heap (for which we are the master). */ //@cindex LAGAlookup globalAddr * LAGAlookup(addr) StgClosure *addr; { GALA *gala; /* We never look for GA's on indirections. -- unknown hacker Well, in fact at the moment we do in the new RTS. -- HWL ToDo: unwind INDs when entering them into the hash table ASSERT(IS_INDIRECTION(addr) == NULL); */ if ((gala = lookupHashTable(LAtoGALAtable, (StgWord) (UNTAG_CLOSURE(addr)))) == NULL) return NULL; else return &(gala->ga); } //@node Interface to GALA table, GC functions for GALA tables, Interface to LAGA table, Global Address Manipulation //@subsection Interface to GALA table /* We also manage a mapping of global addresses to local addresses, so that we can ``common up'' multiple references to the same object as they arrive in data packets from remote PEs. The global address to local address mapping is actually managed via a ``packed global address'' to GALA hash table. The packed global address takes the interesting part of the @globalAddr@ structure (i.e. the pe and slot fields) and packs them into a single word suitable for hashing. */ //@cindex GALAlook up StgClosure * GALAlookup(ga) globalAddr *ga; { StgWord pga = PackGA(ga->pe, ga->slot); GALA *gala; if ((gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga)) == NULL) { return NULL; } else { /* * Bypass any indirections when returning a local closure to * the caller. Note that we do not short-circuit the entry in * the GALA tables right now, because we would have to do a * hash table delete and insert in the LAtoGALAtable to keep * that table up-to-date for preferred GALA pairs. That's * probably a bit expensive. */ //ASSERT(UNTAG_CHECK((StgClosure *)(gala->la))); return UNWIND_IND((StgClosure *)(gala->la)); // tag-safe; tagged result } } /* ga becomes non-preferred (e.g. due to CommonUp) */ void GALAdeprecate(ga) globalAddr *ga; { StgWord pga = PackGA(ga->pe, ga->slot); GALA *gala; gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga); ASSERT(gala!=NULL); ASSERT(gala->preferred==rtsTrue); gala->preferred = rtsFalse; } /* External references to our globally-visible closures are managed through an indirection table. The idea is that the closure may move about as the result of local garbage collections, but its global identity is determined by its slot in the indirection table, which never changes. The indirection table is maintained implicitly as part of the global address to local address table. We need only keep track of the highest numbered indirection index allocated so far, along with a free list of lower numbered indices no longer in use. */ /* Allocate an indirection slot for the closure currently at address @addr@. */ //@cindex allocIndirection static GALA * allocIndirection(StgClosure *closureT) { GALA *gala; if ((gala = freeIndirections) != NULL) { IF_DEBUG(sanity, ASSERT(gala->ga.weight==0xdead0add); ASSERT(gala->la==(StgClosure *)0xdead00aa)); freeIndirections = gala->next; } else { gala = allocGALA(); IF_DEBUG(sanity, ASSERT(gala->ga.weight==0xdead0add); ASSERT(gala->la==(StgClosure *)0xdead00aa)); gala->ga.pe = thisPE; gala->ga.slot = nextIndirection++; IF_DEBUG(sanity, if (nextIndirection>=MAX_SLOTS) barf("Cannot handle more than %d slots for GA in a sanity-checking setup (this is no error)")); } gala->ga.weight = MAX_GA_WEIGHT; gala->la = (StgClosure *)closureT; IF_DEBUG(sanity, gala->next=(struct gala *)0xcccccccc); return gala; } /* This is only used for sanity checking (see LOOKS_LIKE_SLOT) */ StgInt highest_slot (void) { return nextIndirection; } /* Make a local closure globally visible. Called from: GlobaliseAndPackGA Args: closure ... closure to be made visible preferred ... should the new GA become the preferred one (normalle=y true) Allocate a GALA structure and add it to the (logical) Indirections table, by inserting it into the LAtoGALAtable hash table and putting it onto the inPtrs list (only if it is preferred). We have to allocate an indirection slot for it, and update both the local address to global address and global address to local address maps. */ //@cindex makeGlobal globalAddr * makeGlobal(closureT, preferred) // tag-safe StgClosure *closureT; rtsBool preferred; { StgClosure *closure = UNTAG_CLOSURE(closureT); /* check whether we already have a GA for this local closure */ GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgPtr)closure); /* create an entry in the LAGA table */ GALA *newGALA = allocIndirection(closureT); StgWord pga = PackGA(thisPE, newGALA->ga.slot); IF_DEBUG(sanity, ASSERT(newGALA->next==(struct gala *)0xcccccccc);); // ASSERT(HEAP_ALLOCED(closure)); // check that closure might point into the heap; might be static, though // ToDo: check whether this assertion is fulfilled in GUM6 // ASSERT(GALAlookup(&(newGALA->ga)) == NULL); #if defined(PAR_TICKY) /* global statistics gathering */ if (RtsFlags.ParFlags.ParStats.Global && RtsFlags.GcFlags.giveStats > NO_GC_STATS) { globalParStats.local_alloc_GA++; } #endif newGALA->la = closureT; // tagged newGALA->preferred = preferred; if (preferred) { /* The new GA is now the preferred GA for the LA */ if (oldGALA != NULL) { oldGALA->preferred = rtsFalse; // ASSERT(UNTAG_CHECK(closure)); (void) removeHashTable(LAtoGALAtable, (StgWord) closure, (void *) oldGALA); } //ASSERT(UNTAG_CHECK(closure)); insertHashTable(LAtoGALAtable, (StgWord) closure, (void *) newGALA); } /* ASSERT(!isOnInPtrsList(&(newGALA->ga))); */ /* put the new GALA entry on the list of live indirections */ newGALA->next = inPtrs; inPtrs = newGALA; IF_PAR_DEBUG(pack, { char str0[MAX_GA_STR_LEN]; showGA(newGALA, str0); debugBelch("**## makeGlobal: Adding packed GA %u (%d,%d) with GALA ptr %x GA %s LA %x to pGAtoGALAtable\n", pga, thisPE, newGALA->ga.slot, newGALA, str0, newGALA->la); } ); insertHashTable(pGAtoGALAtable, pga, (void *) newGALA); return &(newGALA->ga); } /* Assign an existing remote global address to an existing closure. Called from: Unpack in Pack.c Args: local_closure ... a closure that has just been unpacked remote_ga ... the GA that came with it, ie. the name under which the closure is known while being transferred preferred ... should the new GA become the preferred one (normalle=y true) Allocate a GALA structure and add it to the (logical) RemoteGA table, by inserting it into the LAtoGALAtable hash table and putting it onto the outPtrs list (only if it is preferred). We do not retain the @globalAddr@ structure that's passed in as an argument, so it can be a static in the calling routine. */ //@cindex setRemoteGA globalAddr * setRemoteGA(local_closureT, remote_ga, preferred) // BEWARE: local_closure must be TAGGED StgClosure *local_closureT; globalAddr *remote_ga; rtsBool preferred; { #ifdef DUMMY_BLOCKED_FETCH /* old entry ie the one with the GA generated when sending off the closure */ GALA *oldGALA = (local_closureT==(StgClosure*)NULL)?(GALA*)NULL:lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(local_closureT)); #else ASSERT(local_closureT!=NULL); /* old entry ie the one with the GA generated when sending off the closure */ GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(local_closureT)); #endif ASSERT(local_closureT!=NULL); /* alloc new entry and fill it with contents of the newly arrives GA */ GALA *newGALA = allocGALA(); StgWord pga = PackGA(remote_ga->pe, remote_ga->slot); // @@@@@@@@@@@@@@@@@@@@@@ TODO: CHECK AND ENABLE this assertion again: ASSERT(remote_ga->pe != thisPE); // TODO: CHECK AND ENABLE this assertion again: ASSERT(remote_ga->weight > 0); ASSERT(local_closureT==NULL || GALAlookup(remote_ga) == NULL); newGALA->ga = *remote_ga; newGALA->la = (StgPtr)local_closureT; newGALA->preferred = preferred; if (preferred && local_closureT!=(StgClosure*)NULL) { /* The new GA is now the preferred GA for the LA */ if (oldGALA != NULL) { oldGALA->preferred = rtsFalse; (void) removeHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(local_closureT), (void *) oldGALA); } insertHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(local_closureT), (void *) newGALA); } if (local_closureT != (StgClosure*)NULL) {// it's an unpacked closure => on remoteGA list /* ASSERT(!isOnOutPtrsList(&(newGALA->ga))); */ /* add new entry to the (logical) RemoteGA table */ newGALA->next = outPtrs; outPtrs = newGALA; IF_PAR_DEBUG(pack, { char str0[MAX_GA_STR_LEN]; showGA(newGALA, str0); debugBelch("**## setRemoteGA: Adding packed GA %u (%d,%d) with GALA ptr %x GA %s LA %x to pGAtoGALAtable\n", pga, remote_ga->pe, remote_ga->slot, newGALA, str0, newGALA->la); } ); insertHashTable(pGAtoGALAtable, pga, (void *) newGALA); } #if 0 // ngoq ngo' ; this is now done directly in processFetch else { // it's just a fetch message for a BH that we received => on liveFetchedGA list newGALA->la = NULL; //ASSERT(!isOnFetchedGATable(&(newGALA->ga))); /* add new entry to the (logical) RemoteGA table */ newGALA->next = blockedFetches; blockedFetches = newGALA; IF_PAR_DEBUG(pack, { char str0[MAX_GA_STR_LEN]; showGA(newGALA, str0); debugBelch("**## setRemoteGA: Adding packed GA %u (%d,%d) with GALA ptr %x GA %s LA %x to pGAtoGALAtable\n", pga, remote_ga->pe, remote_ga->slot, newGALA, str0, newGALA->la); } ); insertHashTable(pGAtoGALAtable, pga, (void *) newGALA); } #endif /* The weight carried by the incoming closure is transferred to the newGALA entry (via the structure assign above). Therefore, we have to give back the weight to the GA on the other processor, because that indirection is no longer needed. */ remote_ga->weight = 0; return &(newGALA->ga); } GALA * createBlockedFetch(Capability *cap, StgClosure *closure, globalAddr rga) { GALA *bf; globalAddr *new_rga; bf = allocGALA(); bf->la = closure; /* we create a GALA entry, which we can point to from the Ghost TSO */ // new_rga = setRemoteGA(NULL, &rga, rtsTrue); // create GALA entry with this given rga bf->ga = rga; bf->preferred = rtsFalse; // sent fetch? this info is needed later in checkBlockedFetches (FM case) IF_PAR_DEBUG(fetch, // mpcomm, { char str1[MAX_GA_STR_LEN]; showGA(&(bf->ga), str1); debugBelch("%%%%++ Created blockedFetch for closure %p (%s) with GA %s @ %p\n", closure, info_type(closure), str1, new_rga);};); /* Can we assert something on the remote GA? */ // ASSERT(GALAlookup(&rga) == NULL); return bf; } void setFetchedLA (StgTSO *t) { ASSERT(blockedFetches->la==NULL); blockedFetches->la = (StgClosure*)t; } /* Give me a bit of weight to give away on a new reference to a particular global address. If we run down to MIN_WEIGHT, we have to assign a new GA. */ //@cindex splitWeight void splitWeight(to, from) globalAddr *to, *from; { /* Make sure we have enough weight to split weight must never fall below MIN_GA_WEIGHT, as values weight / 2 < MIN_GA_WEIGHT) { /* old: weight== 1 (UK) */ StgClosure *closureT = GALAlookup(from); from = makeGlobal(closureT, rtsTrue); } *to = *from; if (from->weight < MIN_GA_WEIGHT) /* old == 0 (UK) */ to->weight = 1L << (BITS_IN(unsigned) - 1); // set weight to infinity else to->weight = from->weight / 2; from->weight -= to->weight; } /* Here, I am returning a bit of weight that a remote PE no longer needs. */ //@cindex addWeight globalAddr * addWeight(ga) globalAddr *ga; { StgWord pga; GALA *gala; ASSERT(LOOKS_LIKE_GA(ga)); pga = PackGA(ga->pe, ga->slot); gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga); IF_PAR_DEBUG(weight, fprintf(stderr, "@* Adding weight %x to ", ga->weight); printGA(&(gala->ga)); fputc('\n', stderr)); gala->ga.weight += ga->weight; ga->weight = 0; return &(gala->ga); } /* ----------------------------------------------------------------------------- Initialisation code ----------------------------------------------------------------------------- */ /* Initialize all of the global address structures: the task ID to PE id map, the local address to global address map, the global address to local address map, and the indirection table. */ //@cindex initGAtables rtsBool initGAtables(void) { // taskIDtoPEtable = allocHashTable(); // replaced by allPEs in MPSystem.h LAtoGALAtable = allocHashTable(); pGAtoGALAtable = allocHashTable(); return rtsTrue; // always succeeds } //@cindex PackGA StgWord PackGA (pe, slot) StgWord pe; int slot; { int pe_shift = (BITS_IN(StgWord)*3)/4; int pe_bits = BITS_IN(StgWord) - pe_shift; if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */ fflush(stdout); fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n", slot,pe_bits); stg_exit(EXIT_FAILURE); } return((((StgWord)(pe)) << pe_shift) | ((StgWord)(slot))); /* the idea is to use 3/4 of the bits (e.g., 24) for indirection- table "slot", and 1/4 for the pe# (e.g., 8). We check for too many bits in "slot", and double-check (at compile-time?) that we have enough bits for "pe". We *don't* check for too many bits in "pe", because SysMan enforces a MAX_PEs limit at the very very beginning. Phil & Will 95/08 (AD) */ } //@node GC functions for GALA tables, Debugging routines, Interface to GALA table, Global Address Manipulation //@subsection GC functions for GALA tables /* When we do a copying collection, we want to evacuate all of the local entries in the GALA table for which there are outstanding remote pointers (i.e. for which the weight is not MAX_GA_WEIGHT.) This routine has to be run BEFORE doing the GC proper (it's a ``mark roots'' thing). */ /* Evacuate the closure pointed to by gala->la (if not already evacuated). */ static inline void evacuateGALA(evac_fn evac, void *user, GALA *gala) { GALA *next; StgClosure *old_la, *new_la; StgWord tag; StgInfoTable *info; next = gala->next; tag = GET_CLOSURE_TAG(gala->la); old_la = UNTAG_CLOSURE(gala->la); new_la = old_la; ASSERT(UNTAG_CHECK(old_la)); // if (get_itbl((StgClosure *)old_la)->type == EVACUATED) { // new_la = isAlive(UNTAG_CLOSURE(old_la)); // doesn't work at this stage in GC info = ((StgClosure *)old_la)->header.info; if (IS_FORWARDING_PTR(info)) { // alive! new_la = (StgClosure*)UN_FORWARDING_PTR(info); } else { new_la = (StgClosure*)NULL; } if (new_la != NULL) { /* somebody else already evacuated this closure */ tag = GET_CLOSURE_TAG(new_la); new_la = UNTAG_CLOSURE(new_la); IF_PAR_DEBUG(tables, debugBelch(" %p already evacuated to %p (in evacuateGALA)\n", old_la, new_la)); } else { new_la = UNTAG_CLOSURE(old_la); evac(user/*passed from top-level GC*/, (StgClosure **)&new_la);// see sm/GC.c::mark_root for comment on user register // NB: evac seems to return a TAGGED ptr; need to untag it here tag = GET_CLOSURE_TAG(new_la); new_la = UNTAG_CLOSURE(new_la); IF_PAR_DEBUG(tables, debugBelch(" evacuated %p to %p (in evacuateGALA)\n", old_la, new_la)); /* ToDo: is this the right assertion to check that new_la is in to-space? */ // ASSERT(!HEAP_ALLOCED(new_la) || Bdescr(new_la)->evacuated); } // ASSERT(get_itbl((StgClosure *)old_la)->type == EVACUATED); // new_la = (StgPtr)((StgEvacuated *)old_la)->evacuee; gala->la = TAG_CLOSURE(tag,new_la); /* remove old LA and replace with new LA */ if (/* !full && */ gala->preferred && new_la != old_la) { GALA *q; //TODO: check that old_la is in the hash table this done MKA on 17/11/2009 if ((q = lookupHashTable(LAtoGALAtable, (StgWord)old_la))!=NULL && q==gala) { ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)old_la)); (void) removeHashTable(LAtoGALAtable, (StgWord)old_la, (void *) gala); } ASSERT(UNTAG_CHECK(new_la)); if ((q = lookupHashTable(LAtoGALAtable, (StgWord) new_la))!=NULL) { if (q->preferred && gala->preferred) { q->preferred = rtsFalse; IF_PAR_DEBUG(tables, fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ", new_la, info_type((StgClosure*)new_la)); printGA(&(q->ga)); fputc('\n', stderr)); } } else { ASSERT(UNTAG_CHECK(new_la)); insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala); IF_PAR_DEBUG(tables, fprintf(stderr, "@@## adding new hash entry to LAtoGALAtable: closure %p (%s) -> ", new_la, info_type((StgClosure*)new_la)); fputc('\n', stderr)); } IF_PAR_DEBUG(tables, debugBelch("__## Hash table update (%p --> %p): ", old_la, new_la)); } } // ----------------------------------------------------------------------------- // Management of GALA tables //@cindex markInPtrs void markInPtrs(evac_fn evac, void *user, rtsBool full) { markPtrList(evac, &inPtrs, user, full); } void markOutPtrs(evac_fn evac, void *user, rtsBool full) { markPtrList(evac, &outPtrs, user, full); } void markBlockedFetches(evac_fn evac, void *user, rtsBool full) { markPtrList(evac, &blockedFetches, user, full); } //@cindex markInPtrs void markPtrList(evac_fn evac, GALA **ptrListP, void *user, rtsBool full) { GALA *gala, *next, *prev = NULL; StgClosure *old_la, *new_la; nat n=0, m=0; // debugging only double start_time_GA; // stats only StgInfoTable *info; IF_PAR_DEBUG(tables, debugBelch("@@%%%% markPtrList (full=%d): Marking %s in GALA table starting with GALA at %p\n", full, (ptrListP==&inPtrs)?"IN POINTERS":(ptrListP==&outPtrs)?"OUT POINTERS":(ptrListP==&blockedFetches)?"BLOCKED FETCHES":"UNKNOWN",inPtrs)); // IF_PAR_DEBUG(tables, printLAGAtable()); // is this safe at beginning of GC!? #if defined(PAR_TICKY) // PAR_TICKY_MARK_LOCAL_GAS_START(); #endif for (gala = *ptrListP /*inPtrs*/, prev=NULL, m=0; gala != NULL; gala = next, m++) { // remember next GALA, in case the current turns out to be garbage next = gala->next; // current local address old_la = UNTAG_CLOSURE(gala->la); // check if we already have a new la // new_la = isAlive(old_la); // doesn't work; isAlive can only be used after GC! /* doesn't work either */ new_la = followFwdInfoPtr(((StgClosure *)old_la)->header.info); IF_PAR_DEBUG(tables, { fputs("@@ ",stderr); printGA(&(gala->ga)); fprintf(stderr, ";@ %d: LA: %p (%s) ", m, (void*)old_la, ((new_la!=NULL)?info_type((StgClosure*)UNTAG_CLOSURE(new_la)):info_type((StgClosure*)old_la)), ((new_la!=NULL)?"ALIVE":"EVAC"));}); // TODO: enable this assertion only when marking inPtrs, not outPtrs (the latter shouldn't be marked anyway!!) // ASSERT(gala->ga.pe == thisPE); /* it's supposed to be local */ if (new_la!=NULL) { // alive? // closure has been evacuated already; only update field // NB: this could also be done in rebuildGALAtable; there we could use isAlive gala->la = new_la; prev = gala; } else if(closure_STATIC((StgClosure*)gala->la)) { /* to handle the CAFs, is this all? */ evac(user, &(gala->la)); // NB: evac seems to return a TAGGED ptr; need to untag it here gala->la = UNTAG_CLOSURE(gala->la); IF_PAR_DEBUG(tables, debugBelch(" processed static closure")); n++; prev = gala; } else if (rtsTrue) { // TODO: enable this check, so that FREE msgs are sent if a GA becomes garbage!!! (gala->ga.weight != MAX_GA_WEIGHT) { /* Remote references exist, so we must evacuate the local closure */ evacuateGALA(evac, user, gala); n++; prev = gala; } else { /* Since we have all of the weight, this GA is no longer needed and has to be removed from the list */ StgWord pga = PackGA(thisPE, gala->ga.slot); // TODO: currently dead code; enable FREE msgs barf("Never freeing GAs"); IF_PAR_DEBUG(weight, debugBelch("@@!! Freeing slot %d", gala->ga.slot)); /* put gala on free indirections list */ gala->next = freeIndirections; freeIndirections = gala; (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); if (/* !full && */ gala->preferred) { (void) removeHashTable(LAtoGALAtable, (W_) UNTAG_CLOSURE(gala->la), (void *) gala); } // remove the current gala entry from the list if (prev==NULL) { *ptrListP = next; } else { prev->next = next; } // NB: prev unchanged in this case IF_DEBUG(sanity, gala->ga.weight = 0xdead0add; gala->la = (StgPtr) 0xdead00aa); } } /* for gala ... */ #if defined(PAR_TICKY) // PAR_TICKY_MARK_LOCAL_GAS_END(n+m); #endif IF_PAR_DEBUG(tables, debugBelch("@@%%%% markPtrList: %d of %d GALAs marked on PE %x", n, m, thisPE)); } /* Rebuild the LA->GA table, assuming that the addresses in the GALAs are correct. A word on the lookupHashTable check in both loops: After GC we may end up with 2 preferred GAs for the same LA! For example, if we received a closure whose GA already exists on this PE we CommonUp both closures, making one an indirection to the other. Before GC everything is fine: one preferred GA refers to the IND, the other preferred GA refers to the closure it points to. After GC, however, we have short cutted the IND and suddenly we have 2 preferred GAs for the same closure. We detect this case in the loop below and deprecate one GA, so that we always just have one preferred GA per LA. About tagging: LAs in the table are TAGGED in general. This means we have to do an UNTAG_CLOSURE on them before derefencing them. We also need to remember the tag and put it on the new gala->la field. */ //@cindex rebuildLAGAtable void rebuildLAGAtable(void) { GALA *gala, *prev ,*next, *old_gala ; nat n=0, m=0, k=0; // debugging // printLAGAtable(); #if defined(PAR_TICKY) par_ticky_rebuildGAtables_start(); #endif /* The old LA->GA table is worthless */ freeHashTable(LAtoGALAtable, NULL); LAtoGALAtable = allocHashTable(); #if !defined(DUMMY_FREE) // TODO: MUST add this line to work properly prepareFreeMsgBuffers(); #endif IF_PAR_DEBUG(tables, debugBelch("@@%%%% rebuildLAGAtable: new LAGA table at %p", LAtoGALAtable)); IF_PAR_DEBUG(tables, debugBelch("... rebuilding inPtrs list")); // first, rebuild the inPtrs list in the GALA table // they are roots to GC, so no free message should be sent if the la is garbage n = rebuildGALAlist(&inPtrs, rtsFalse); IF_PAR_DEBUG(tables, debugBelch("... rebuilding outPtrs list")); // next, rebuild the outPtrs list in the GALA table // if an la becomes garbage we send a free message m = rebuildGALAlist(&outPtrs, rtsTrue); IF_PAR_DEBUG(tables, debugBelch("... rebuilding blockedFetches list")); // next, rebuild the blockedFetches list in the GALA table // i.e. all GAs of remote TSOs waiting for data locally under evaluation // no need to send a free message (conceptually these are inPtrs) k = rebuildGALAlist(&blockedFetches, rtsFalse); #if defined(PAR_TICKY) par_ticky_rebuildGAtables_end(n+m+k, (n+m+k)*sizeofW(GALA)); #endif IF_PAR_DEBUG(tables, debugBelch("@@%%%% rebuildLAGAtable: holding %d entries from inPtrs, %d entries from outPtrs and %d entries from blockedFetches\n", n,m,k)); IF_PAR_DEBUG(tables, printLAGAtable()); } /* This is the main loop of rebuilding the local address in the GALA entries (gala->la). It is called with inPtrs, outPtrs and blockedFetches in turn as values for list_rootP. The behaviour differs depending on the freeGAs flags: - if freeGAs is true, we send a free message to the pe recorded in the GA in case the local closure is garbage; this should be done for the outPtrs list - if freeGAs is false, no such message should be sent; this should be done for the inPtrs list, since all entries on this list are roots to GC (and thus MUST be alive) The return value is the number of live GALA entries aftger rebuilding. */ nat rebuildGALAlist(GALA **list_rootP, rtsBool freeGAs) { GALA *gala, *prev ,*next, *old_gala ; nat n=0; // printLAGAtable(); for (gala = *list_rootP, prev= NULL; gala != NULL; gala = next) { /* better code: StgClosure *closure = UNTAG_CLOSURE(gala->la); StgWord tag = GET_CLOSURE_TAG(gala->la); */ StgClosure *closureT; StgClosure *new_closure; StgClosure *old_closure; // just for PAR_DEBUG tracing // remember next link, in case the gala entry becomes garbage next = gala->next; /* if we are on the liveFetchedGA list, there is nothing to update */ if ((gala->la)==NULL) { continue ; } // old_gala = gala; closureT = (StgClosure *) (gala->la); // TAGGED IF_PAR_DEBUG(tables, fprintf(stderr, " %p (%s) ", (StgClosure *)closureT, info_type(UNTAG_CLOSURE(closureT)))); /* Follow indirection chains to the end, just in case */ // should conform with unwinding in markInPtrs // Problem: this might be garbage now! // closureT = UNWIND_IND(closureT); // tag-safe; tagged result // old_closure = UNTAG_CLOSURE(closureT); // NO: we need the tag below old_closure = UNTAG_CLOSURE(closureT); //ASSERT(UNTAG_CHECK(closure)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(UNTAG_CLOSURE(closureT))); if (closureT = isAlive(UNTAG_CLOSURE(closureT))) { // closureT = ((StgEvacuated *)UNTAG_CLOSURE(closureT))->evacuee; IF_PAR_DEBUG(tables, fprintf(stderr, " EVAC %p -> %p (%s)\n", old_closure, UNTAG_CLOSURE(closureT), info_type(UNTAG_CLOSURE(closureT)))); n++; prev = gala; } else { // closure not alive => send a free message /* this can only happen on the outPtrs list, which is root to GC */ ASSERT(freeGAs); // debugBelch("@@%%%% found non-evac local closure %p (%s); OMITTING a FREE message for now!!", closure, info_type(closure)); // mustafa to back here // TODO: check whether FREE message is sent elsewhere (shouldn't) /* closure is not alive any more, thus remove GA and send free msg */ nat pe = gala->ga.pe; StgWord pga = PackGA(pe, gala->ga.slot); /* check that the block containing this closure is not in to-space */ IF_PAR_DEBUG(tables, fprintf(stderr, " !EVAC %p (%s); sending free to PE %d\n", UNTAG_CLOSURE(closureT), info_type(closureT), pe)); # if !defined(DUMMY_FREE) (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); freeRemoteGA((int) pe, &(gala->ga));//-1 cause ids start at 1... not 0 gala->next = freeGALAList; // put GALA entry on the freelist freeGALAList = gala; // remove the current gala entry from the list if (prev==NULL) { *list_rootP = next; } else { prev->next = next; } // NB: prev unchanged in this case IF_DEBUG(sanity, gala->ga.weight = 0xdead0add; gala->la = (StgPtr)0xdead00aa); # else prev = gala; # endif // check that we don't have to fix hash tables in this case continue; } // better code: gala->la = TAG_CLOSURE(tag, (StgPtr)closure); // update local closure!! core of rebuilding gala->la = (StgPtr)closureT; // update local closure (TAGGED)!! core of rebuilding // finally rebuild the hash tables, to reflect that the local address in the GALA entry has changed if (list_rootP!=&blockedFetches && gala->preferred) { // for blockedFetches the preferred field has a different meaning GALA *q; q = lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la)); if ((q = lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la)))!=NULL) { if (q->preferred && gala->preferred) { /* this deprecates q (see also GALAdeprecate) */ q->preferred = rtsFalse; (void) removeHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *)q); IF_PAR_DEBUG(tables, fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ", gala->la, info_type((StgClosure*)gala->la)); printGA(&(q->ga)); fputc('\n', stderr)); } } insertHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *) gala); } } return n; } // ----------------------------------------------------------------------------- /* Determine the size of the LAGA and GALA tables. Has to be done after rebuilding the tables. Only used for global statistics gathering. */ //@cindex getLAGAtableSize void getLAGAtableSize(nat *nP, nat *sizeP) { GALA *gala; // nat n=0, tot_size=0; StgClosure *closure; StgInfoTable *info; nat size, ptrs, nonptrs, vhs, i; /* IN order to avoid counting closures twice we maintain a hash table of all closures seen so far. ToDo: collect this data while rebuilding the GALA table and make use of the existing hash tables; */ HashTable *closureTable; // hash table for closures encountered already closureTable = allocHashTable(); (*nP) = (*sizeP) = 0; for (gala = inPtrs; gala != NULL; gala = gala->next) { closure = (StgClosure*) UNTAG_CLOSURE(gala->la); if (lookupHashTable(closureTable, (StgWord)(closure))==NULL) { // not seen yet insertHashTable(closureTable, (StgWord)(closure), (void *)1); info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs); (*sizeP) += size ; // stats: measure total heap size of global closures (*nP)++; // stats: count number of GAs } } for (gala = outPtrs; gala != NULL; gala = gala->next) { closure = (StgClosure*) UNTAG_CLOSURE(gala->la); if (lookupHashTable(closureTable, (StgWord)(closure))==NULL) { // not seen yet insertHashTable(closureTable, (StgWord)(closure), (void *)1); info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs); (*sizeP) += size ; // stats: measure total heap size of global closures (*nP)++; // stats: count number of GAs } } freeHashTable(closureTable, NULL); } // ----------------------------------------------------------------------------- //@node Debugging routines, Index, GC functions for GALA tables, Global Address Manipulation //@subsection Debugging routines //@cindex showGA void showGA (globalAddr *ga, char *str) { sprintf(str, "((%u, %u, %x))", ga->pe, ga->slot, ga->weight); } //@cindex printGA void printGA (globalAddr *ga) { fprintf(stderr, "((%u, %u, %x))", ga->pe, ga->slot, ga->weight); } //@cindex printGALA void printGALA (GALA *gala) { //ASSERT(UNTAG_CHECK(gala->la)); printGA(&(gala->ga)); fprintf(stderr, " -> %p (%s)", (StgClosure*)gala->la, info_type((StgClosure*)UNTAG_CLOSURE(gala->la))); fprintf(stderr, " %s", (gala->preferred) ? "PREF" : "____"); } /* Printing the LA->GA table. */ //@cindex printInPtrsList nat GALA_list_len (GALA *gala) { nat n; for (n = 0; gala != NULL; n++, gala = gala->next) { /* nothing */ } return n; } //@cindex printInPtrsList void printInPtrsList (void) { GALA *gala, *q; StgClosure *la; nat n=0; // debugging debugBelch("@@%%%%:: inPtrs (%p) (inPtrs=%p):", LAtoGALAtable, inPtrs); for (gala = inPtrs; gala != NULL; gala = gala->next) { n++; printGALA(gala); /* check whether this gala->la is hashed into the LAGA table */ la = UNTAG_CLOSURE(gala->la); q = lookupHashTable(LAtoGALAtable, (StgWord)la); fprintf(stderr, "\t%s", (q==NULL) ? "_______" : (q==gala) ? "====" : "####"); // fprintf(stderr,"\n this is LAtoGALAtable %x \n",LAtoGALAtable); // TODO: enable: ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)la)); fprintf(stderr, "\t%s\n", (UNTAG_CHECK(gala->la)) ? "UNTAGGED" : "TAGGED"); } debugBelch("@@%%%%:: %d inPtrs", n); } void printOutPtrsList(void) { GALA *gala, *q; StgClosure *la; nat m=0; // debugging debugBelch("@@%%%%:: outPtrs (%p) (outPtrs=%p):", LAtoGALAtable, outPtrs); for (gala = outPtrs; gala != NULL; gala = gala->next) { m++; printGALA(gala); /* check whether this gala->la is hashed into the LAGA table */ la = UNTAG_CLOSURE(gala->la); q = lookupHashTable(LAtoGALAtable, (StgWord)la); fprintf(stderr, "\t%s", (q==NULL) ? "...." : (q==gala) ? "====" : "####"); fprintf(stderr, "\t%s", (UNTAG_CHECK(gala->la)) ? "UNTAGGED" : "TAGGED"); if (get_itbl(la)->type == FETCH_ME) { fputs(" ; FETCH_ME is pointing to ",stderr); printGA(((StgFetchMe*)la)->ga); fputs("\n", stderr); } else { fputs(" this is not a FETCH_ME \n",stderr); } // TODO with the assert is comment byu MKA 24/11/2009 // ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)UNTAG_CLOSURE((gala->la)))); } debugBelch("@@%%%%:: %d outPtrs", m); } // ----------------------------------------------------------------------------- //@node Debugging routines, Index, GC functions for GALA tables, Global Address Manipulation //@subsection Debugging routines //@cindex printLAGAtable void printLAGAtable(void) { debugBelch("@@%%: LAGAtable (%p) with inPtrs=%p, outPtrs=%p:", LAtoGALAtable, inPtrs, outPtrs); printInPtrsList(); printOutPtrsList(); } //@cindex showGALA void showGALA (GALA *gala, char *str) { char str0[MAX_GA_STR_LEN]; showGA(&(gala->ga), str0); #if defined(DEBUG) // JB HACK sprintf(str, "%s -> %p (%s) %s", str0, (StgClosure*)gala->la, info_type((StgClosure*)UNTAG_CLOSURE(gala->la)), (gala->preferred) ? "PREF" : "____"); #endif } /* Check whether a GA is already in a list. */ rtsBool isOnInPtrsList(globalAddr *ga) { GALA *gala; for (gala = inPtrs; gala != NULL; gala = gala->next) if (gala->ga.weight==ga->weight && gala->ga.slot==ga->slot && gala->ga.pe==ga->pe) return rtsTrue; return rtsFalse; } rtsBool isOnOutPtrsList(globalAddr *ga) { GALA *gala; for (gala = outPtrs; gala != NULL; gala = gala->next) if (gala->ga.weight==ga->weight && gala->ga.slot==ga->slot && gala->ga.pe==ga->pe) return rtsTrue; return rtsFalse; } /* Sanity check for free lists. */ void checkFreeGALAList(void) { GALA *gl; for (gl=freeGALAList; gl != NULL; gl=gl->next) { ASSERT(gl->ga.weight==0xdead0add); ASSERT(gl->la==(StgPtr)0xdead00aa); } } void checkFreeIndirectionsList(void) { GALA *gl; for (gl=freeIndirections; gl != NULL; gl=gl->next) { ASSERT(gl->ga.weight==0xdead0add); ASSERT(gl->la==(StgPtr)0xdead00aa); } }//@cindex checkLAGAtable void checkLAGAtable(rtsBool check_closures) { GALA *gala, *gala0; StgTSO *t; StgClosure *la; nat n=0, m=0, k=0; // debugging for (gala = inPtrs; gala != NULL; gala = gala->next) { n++; la = UNTAG_CLOSURE((StgClosure *)gala->la); gala0 = lookupHashTable(LAtoGALAtable, (StgWord) la); // was (before tagging): gala->la); // check whether this invariant should hold // ASSERT(!gala->preferred || gala == gala0); IF_DEBUG(sanity, ASSERT(LOOKS_LIKE_GA(&(gala->ga)))); ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)la)->header.info)); ASSERT(gala->next!=gala); // detect direct loops #if defined(DEBUG) if ( check_closures ) { fprintf(stderr, "\n\n frst check in global .c file \n\n"); checkClosure((StgClosure *)la); // was: gala->la)); } #endif IF_PAR_DEBUG(paranoia, debugBelch("__-> CLOSURE %s (%p)\tliveInd\tOK\n", info_type(la), la)); } for (gala = outPtrs; gala != NULL; gala = gala->next) { m++; la = UNTAG_CLOSURE((StgClosure *)gala->la); gala0 = lookupHashTable(LAtoGALAtable, (StgWord) la); // was:gala->la); // check whether this invariant should hold // ASSERT(!gala->preferred || gala == gala0); IF_DEBUG(sanity, ASSERT(LOOKS_LIKE_GA(&(gala->ga)))); ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)la)->header.info)); ASSERT(gala->next!=gala); // detect direct loops #if defined(DEBUG) if ( check_closures ) { fprintf(stderr, "\n\n scd check in global .c file \n\n"); checkClosure((StgClosure *)la); // was: gala->la)); } #endif IF_PAR_DEBUG(paranoia, debugBelch("__-@ CLOSURE %s (%p)\tliveRemote\tOK\n", info_type(la), la)); } for (gala = blockedFetches; gala != NULL; gala = gala->next) { k++; la = UNTAG_CLOSURE((StgClosure *)gala->la); // gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); // ASSERT(!gala->preferred || gala == gala0); IF_DEBUG(sanity, ASSERT(LOOKS_LIKE_GA(&(gala->ga)))); //ASSERT(get_itbl((StgClosure *)gala->la)->type == TSO); // ghost TSO if ( check_closures ) { // check that we have a GA hidden in a field of the TSO // TODO: check for Ghost TSO fields /* IF_DEBUG(sanity, ASSERT(LOOKS_LIKE_GA((globalAddr*) ((StgTSO *)la)->par.process ))); */ } t = la; // was: (StgTSO *)gala->la; IF_PAR_DEBUG(paranoia, debugBelch("__-< TSO %d (%p)\t(why_blocked=%d; closure=%p %s)\tliveFetched\tOK\n", t->id, t, t->why_blocked, t->block_info.closure, info_type(t->block_info.closure))); } // debugBelch("@@%%%%:: checked %d live indirections, %d remote GAs, %d fetched GAs", n,m,k); } void checkBFQ(Capability *cap) { GALA *bf; for (bf=blockedFetches; bf!=(GALA*)NULL; bf=bf->next) { ASSERT(LOOKS_LIKE_GA(&(bf->ga))); ASSERT(LOOKS_LIKE_CLOSURE_PTR(UNTAG_CLOSURE(bf->la))); } } // +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ngoq ngo' // all this code is DEAD CODE #if 0 /* This should not be necessary at all! DELETEME DELETEME DELETEME DELETEME DELETEME DELETEME DELETEME DELETEME THIS IS DEAD CODE. markOutPtrs has the same structure as markInPtrs, but iterates over a different table. */ //@cindex markRemotaGAs void markRemotaGAs(evac_fn evac, void *user, rtsBool full) { GALA *gala, *next, *prev = NULL; StgPtr old_la, new_la; nat n=0, m=0; // debugging only double start_time_GA; // stats only IF_PAR_DEBUG(tables, debugBelch("@@%%%% markOutPtrs (full=%d): Marking REMOTA GAs in GALA table starting with GALA at %p\n", full, outPtrs); printLAGAtable()); // PAR_TICKY_MARK_LOCAL_GAS_START(); for (gala = outPtrs, m=0; gala != NULL; gala = next, m++) { IF_PAR_DEBUG(tables, fputs("@@ ",stderr); printGA(&(gala->ga)); fprintf(stderr, ";@ %d: LA: %p (%s) ", m, (void*)gala->la, info_type((StgClosure*)gala->la))); next = gala->next; old_la = gala->la; ASSERT(gala->ga.pe != thisPE); /* it's supposed to be remote */ if (gala->ga.weight != MAX_GA_WEIGHT) { /* Remote references exist, so we must evacuate the local closure */ evacuateGALA(evac, user, gala); n++; gala->next = prev; prev = gala; } else if(closure_STATIC((StgClosure*)gala->la)) { /* to handle the CAFs, is this all?*/ evac(user, &(gala->la)); // NB: evac seems to return a TAGGED ptr; need to untag it here gala->la = UNTAG_CLOSURE(gala->la); IF_PAR_DEBUG(tables, debugBelch(" processed static closure")); n++; gala->next = prev; prev = gala; } else { // TODO: enable the code below, putting GALA entries on a free list IF_PAR_DEBUG(verbose, debugBelch ("Ignoring Free in markRemoteGAs")); //continue; /* Since we have all of the weight, this GA is no longer needed */ StgWord pga = PackGA(thisPE, gala->ga.slot); IF_PAR_DEBUG(weight, debugBelch("@@!! Freeing slot %d", gala->ga.slot)); /* put gala on free indirections list */ gala->next = freeIndirections; freeIndirections = gala; (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); if (/* !full && */ gala->preferred) { (void) removeHashTable(LAtoGALAtable, (W_) UNTAG_CLOSURE(gala->la), (void *) gala); } IF_DEBUG(sanity, gala->ga.weight = 0xdead0add; gala->la = (StgPtr) 0xdead00aa); } } /* for gala ... */ outPtrs = prev; /* list has been reversed during the marking */ // PAR_TICKY_MARK_LOCAL_GAS_END(n); IF_PAR_DEBUG(tables, debugBelch("@@%%%% markOutPtrs: %d of %d GALAs marked on PE %x", n, m, thisPE)); } #endif #if 0 // now done in traverseGhostTSOs /* This is different: We mark the block_info.closure of every Ghost TSO that is in the liveFetchedGA list, because the existence of this TSO represents a cross PE pointer to block_info.closure, and it is therefore alive (even if it is not needed on the local PE any more). The location of the TSO is recorded in the la field of the gala entry. Note that we don't directly mark the Ghost TSO itself. It must be on the blackhole_queue and will be evacuated as part of the generic GC code. But this needs to be done after everything else has been evaced/scanvenged (in GC.c:traverse_blackhole_queue) */ //@cindex markFetchedGAs void markFetchedGAs(evac_fn evac, void *user, rtsBool full) { // BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN BROKEN // this code needs fixing GALA *galaT, *nextT, *prevT = NULL; StgClosure *old_la, *new_la; nat n=0, m=0; // debugging only double start_time_GA; // stats only IF_PAR_DEBUG(tables, debugBelch("@@%%%% markFetchedGAs (full=%d): Marking block_info.closure of all Ghost TSOs (GALA table starting with GALA at %p)\n", full, blockedFetches)); // printLAGAtable()); // PAR_TICKY_MARK_LOCAL_GAS_START(); for (galaT = blockedFetches, m=0; galaT != NULL; galaT = nextT, m++) { IF_PAR_DEBUG(tables, { char str[MAX_GA_STR_LEN]; showGA(&(galaT->ga), str); debugBelch("@@ %s; %d: LA: %p (%s) \n", str, m, (void*)galaT->la, info_type(UNTAG_CLOSURE((StgClosure*)galaT->la)));}); nextT = galaT->next; old_la = galaT->la; ASSERT(galaT->ga.pe != thisPE); /* it's supposed to be remote */ ASSERT(get_itbl(UNTAG_CLOSURE((StgClosure*)galaT->la))->type == TSO); // ?? always TSO; what if updated in the meantime if (galaT->ga.weight != MAX_GA_WEIGHT) { /* Remote references exist, so we must evacuate the local closure */ StgTSO *t = (StgTSO*)galaT->la; // debugging ASSERT(LOOKS_LIKE_INFO_PTR((t->block_info.closure)->header.info)); evac(user, &(t->block_info.closure));// TODO: check new (binary) evac fct -- HWL GUM6EDEN // NB: evac seems to return a TAGGED ptr; need to untag it here t->block_info.closure = UNTAG_CLOSURE(t->block_info.closure); IF_PAR_DEBUG(weight, debugBelch("@@!! evacuated block_info closure of Ghost TSO %d (%p) (why_blocked=%d) to %p (%s)\n", t->id, t, t->why_blocked, t->block_info.closure, info_type(t->block_info.closure))); n++; galaT->next = prevT; prevT = galaT; } else { // TODO: enable the code below, putting GALA entries on a free list IF_PAR_DEBUG(verbose, debugBelch ("Ignoring Free in markFetchedGAs")); //continue; /* Since we have all of the weight, this GA is no longer needed */ StgWord pga = PackGA(thisPE, galaT->ga.slot); StgTSO *t = (StgTSO*)galaT->la; // debugging # if !defined(DUMMY_FREE) IF_PAR_DEBUG(weight, debugBelch("@@!! Freeing slot %d", galaT->ga.slot)); /* put gala on free indirections list */ galaT->next = freeIndirections; freeIndirections = galaT; (void) removeHashTable(pGAtoGALAtable, pga, (void *) galaT); if (/* !full && */ galaT->preferred) { (void) removeHashTable(LAtoGALAtable, (W_) UNTAG_CLOSURE(galaT->la), (void *) galaT); } IF_DEBUG(sanity, galaT->ga.weight = 0xdead0add; galaT->la = (StgPtr) 0xdead00aa); # else IF_PAR_DEBUG(weight, debugBelch("@@!! slot %d (TSO %d (%p)) should be freed; omitted at the moment\n", galaT->ga.slot, ((StgTSO *)galaT->la)->id, galaT->la )); /* Don't evac here (TSO should be evac'ed only at end of GC!) For now we never GC Ghost TSOs, so no special evac code is needed here see GC.c:traverse_weak_ptr_list for code to keep Ghost TSO unconditionally NB: TSO must be on Global TSO list to be GCed at end of generic GC code */ // ASSERT(isOnGlobalTSOList((StgTSO*)galaT->la)); // evac(&(gala->la)); IF_PAR_DEBUG(weight, debugBelch("@@!! NOT evacuated TSO %d (%p) to %p\n", t->id, t, galaT->la)); n++; galaT->next = prevT; prevT = galaT; # endif } } /* for gala ... */ blockedFetches = prevT; /* list has been reversed during the marking */ // PAR_TICKY_MARK_LOCAL_GAS_END(n); IF_PAR_DEBUG(tables, debugBelch("@@%%%% markFetchedGAs: %d of %d GALAs marked on PE %x\n", n, m, thisPE)); } #endif #if 0 IF_PAR_DEBUG(tables, debugBelch("... rebuilding Live Remote GAs")); for (gala = outPtrs, prev = NULL; gala != NULL;prev =old_gala, gala = gala->next) { StgClosure *closureT; m++; next = gala-next; old_gala = gala; closureT = (StgClosure *) (gala->la); IF_PAR_DEBUG(tables, fprintf(stderr, " %p (%s) ", (StgClosure *)closureT, info_type(UNTAG_CLOSURE(closureT)))); /* Follow indirection chains to the end, just in case */ // should conform with unwinding in markInPtrs closureT = UNWIND_IND(closureT); // tag-safe; tagged result // checkLAGAtable(rtsTrue); mka // if (get_itbl(UNTAG_CLOSURE(closure))->type == EVACUATED) { if (closureT = isAlive(UNTAG_CLOSURE(closureT))) { // closure = ((StgEvacuated *)UNTAG_CLOSURE(closure))->evacuee; IF_PAR_DEBUG(tables, fprintf(stderr, " EVAC %p (%s)\n", closureT, info_type(UNTAG_CLOSURE(closureT)))); } else { // debugBelch("@@%%%% found non-evac local closure %p (%s); OMITTING a FREE message for now!!", closure, info_type(closure)); //continue; // TODO: check whether FREE message is sent elsewhere /* closure is not alive any more, thus remove GA and send free msg */ nat pe = gala->ga.pe; StgWord pga = PackGA(pe, gala->ga.slot); /* check that the block containing this closure is not in to-space */ IF_PAR_DEBUG(tables, fprintf(stderr, " !EVAC %p (%s); sending free to PE %d\n", closureT, info_type(UNTAG_CLOSURE(closureT)), pe)); # if !defined(DUMMY_FREE) (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); freeRemoteGA((int) pe, UNTAG_CLOSURE(&(gala->ga))); //-1 cause ids start at 1... not 0 gala->next = freeGALAList; freeGALAList = gala; if (prev == NULL) outPtrs = next; else prev = gala->next; gala = old_gala ; fprintf(stderr, " !EVAC %p (%s); sending free to PE %d\n", closureT, info_type(UNTAG_CLOSURE(closureT)), pe); IF_DEBUG(sanity, gala->ga.weight = 0xdead0add; gala->la = (StgPtr)0xdead00aa); #else gala->next = prev; prev = gala; # endif continue; } gala->la = (StgPtr)closureT; // update local closure!! core of rebuilding if (gala->preferred) { GALA *q; if ((q = lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la)))!=NULL) { if (q->preferred && gala->preferred) { /* this deprecates q (see also GALAdeprecate) */ q->preferred = rtsFalse; (void) removeHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *)q); IF_PAR_DEBUG(tables, fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ", (StgClosure*)gala->la, info_type((StgClosure*)gala->la)); printGA(&(q->ga)); fputc('\n', stderr)); } } insertHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *) gala); } } #if 1 // TODO: check that this is the same loop as above, but over liveFetchedGSs!! for (gala = blockedFetches, prev = NULL ; gala != NULL;old_gala = gala, gala = gala->next) { StgClosure *closureT; k++; next = gala->next; old_gala = gala; closureT = (StgClosure *) (gala->la); // TAGGED IF_PAR_DEBUG(tables, fprintf(stderr, " %p (%s) ", (StgClosure *)closureT, info_type(UNTAG_CLOSURE(closureT)))); /* Follow indirection chains to the end, just in case */ // should conform with unwinding in markInPtrs closureT = UNWIND_IND(closureT); // tag-safe; tagged result // if (get_itbl(UNTAG_CLOSURE(closure))->type == EVACUATED) { if (closureT = isAlive(UNTAG_CLOSURE(closureT))) { // closure = ((StgEvacuated *)UNTAG_CLOSURE(closure))->evacuee; IF_PAR_DEBUG(tables, fprintf(stderr, " EVAC %p (%s)\n", closureT, info_type(UNTAG_CLOSURE(closureT)))); } else { // debugBelch("@@%%%% found non-evac local closure %p (%s); OMITTING a FREE message for now!!", closure, info_type(closure)); if ( prev==NULL) blockedFetches= next; else prev = gala->next; gala = old_gala; // continue; } gala->la = (StgPtr)closureT; // update local closure!! core of rebuilding if (gala->preferred) { GALA *q; if ((q = lookupHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la)))!=NULL) { if (q->preferred && gala->preferred) { /* this deprecates q (see also GALAdeprecate) */ q->preferred = rtsFalse; (void) removeHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *)q); IF_PAR_DEBUG(tables, fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ", (StgClosure*)gala->la, info_type((StgClosure*)gala->la)); printGA(&(q->ga)); fputc('\n', stderr)); } } insertHashTable(LAtoGALAtable, (StgWord) UNTAG_CLOSURE(gala->la), (void *) gala); } } #endif #if defined(PAR_TICKY) par_ticky_rebuildGAtables_end(n+m+k, (n+m+k)*sizeofW(GALA)); #endif IF_PAR_DEBUG(tables, debugBelch("@@%%%% rebuildLAGAtable: inserted %d entries from inPtrs, %d entries from outPtrs and %d entries from blockedFetches\n", n,m,k)); } #endif /* 0 */ #endif /* PARALLEL_HASKELL & GUM*/ //@node Index, , Debugging routines, Global Address Manipulation //@subsection Index //@index //* DebugPrintLAGAtable:: @cindex\s-+DebugPrintLAGAtable //* GALAlookup:: @cindex\s-+GALAlookup //* LAGAlookup:: @cindex\s-+LAGAlookup //* LAtoGALAtable:: @cindex\s-+LAtoGALAtable //* PackGA:: @cindex\s-+PackGA //* addWeight:: @cindex\s-+addWeight //* allocGALA:: @cindex\s-+allocGALA //* allocIndirection:: @cindex\s-+allocIndirection //* freeIndirections:: @cindex\s-+freeIndirections //* initGAtables:: @cindex\s-+initGAtables //* inPtrs:: @cindex\s-+inPtrs //* outPtrs:: @cindex\s-+outPtrs //* makeGlobal:: @cindex\s-+makeGlobal //* markInPtrs:: @cindex\s-+markInPtrs //* nextIndirection:: @cindex\s-+nextIndirection //* pGAtoGALAtable:: @cindex\s-+pGAtoGALAtable //* printGA:: @cindex\s-+printGA //* printGALA:: @cindex\s-+printGALA //* rebuildLAGAtable:: @cindex\s-+rebuildLAGAtable //* registerTask:: @cindex\s-+registerTask //* setRemoteGA:: @cindex\s-+setRemoteGA //* splitWeight:: @cindex\s-+splitWeight //* taskIDtoPE:: @cindex\s-+taskIDtoPE //* taskIDtoPEtable:: @cindex\s-+taskIDtoPEtable //* thisPE:: @cindex\s-+thisPE //@end index