+++ /dev/null
-/* ---------------------------------------------------------------------------
- Time-stamp: <Wed Mar 21 2001 16:32:23 Stardate: [-30]6363.44 hwloidl>
-
- (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.
- ------------------------------------------------------------------------- */
-
-#ifdef PAR /* whole file */
-
-//@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 "Storage.h"
-#include "Hash.h"
-#include "HLC.h"
-#include "ParallelRts.h"
-#if defined(DEBUG)
-# include "Sanity.h"
-#include "ParallelDebug.h"
-#endif
-#if defined(DIST)
-# include "Dist.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
-
-//@cindex thisPE
-nat thisPE;
-
-//@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))
-
-/* Free list of indirections */
-
-//@cindex nextIndirection
-static StgInt nextIndirection = 0;
-//@cindex freeIndirections
-GALA *freeIndirections = NULL;
-
-/* The list of live indirections has to be marked for GC (see makeGlobal) */
-//@cindex liveIndirections
-GALA *liveIndirections = NULL;
-
-/* The list of remote indirections has to be marked for GC (see setRemoteGA) */
-//@cindex liveRemoteGAs
-GALA *liveRemoteGAs = 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 = (GlobalTaskId, Slot, Weight))
- Mapping local to global addresses (see interface below)
-*/
-
-//@cindex LAtoGALAtable
-HashTable *LAtoGALAtable = NULL;
-
-/* GALA table: globalAddr* -> StgClosure*
- (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
- Mapping global to local addresses (see interface below)
-*/
-
-//@cindex pGAtoGALAtable
-HashTable *pGAtoGALAtable = NULL;
-
-//@node Fcts on GALA tables, Interface to taskId-PE table, Global tables and lists, Global Address Manipulation
-//@subsection Fcts on GALA tables
-
-//@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;
-}
-
-//@node Interface to taskId-PE table, Interface to LAGA table, Fcts on GALA tables, Global Address Manipulation
-//@subsection Interface to taskId-PE table
-
-/*
- We don't really like GLOBAL_TASK_ID, so we keep a table of TASK_ID to
- PE mappings. The idea is that a PE identifier will fit in 16 bits, whereas
- a TASK_ID may not.
-*/
-
-//@cindex taskIDtoPE
-PEs
-taskIDtoPE(GlobalTaskId gtid)
-{
- return ((PEs) lookupHashTable(taskIDtoPEtable, gtid));
-}
-
-//@cindex registerTask
-void
-registerTask(GlobalTaskId gtid) {
- nextPE++; //start counting from 1
- if (gtid == mytid)
- thisPE = nextPE;
-
- insertHashTable(taskIDtoPEtable, gtid, (void *) (StgWord) nextPE);
-}
-
-//@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) 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 GALAlookup
-StgClosure *
-GALAlookup(ga)
-globalAddr *ga;
-{
- StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.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.
- */
- return UNWIND_IND((StgClosure *)(gala->la));
- }
-}
-
-/* ga becomes non-preferred (e.g. due to CommonUp) */
-void
-GALAdeprecate(ga)
-globalAddr *ga;
-{
- StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.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 *closure)
-{
- GALA *gala;
-
- if ((gala = freeIndirections) != NULL) {
- IF_DEBUG(sanity,
- ASSERT(gala->ga.weight==0xdead0add);
- ASSERT(gala->la==(StgPtr)0xdead00aa));
- freeIndirections = gala->next;
- } else {
- gala = allocGALA();
- IF_DEBUG(sanity,
- ASSERT(gala->ga.weight==0xdead0add);
- ASSERT(gala->la==(StgPtr)0xdead00aa));
- gala->ga.payload.gc.gtid = mytid;
- gala->ga.payload.gc.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 = (StgPtr)closure;
- 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
- liveIndirections 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(closure, preferred)
-StgClosure *closure;
-rtsBool preferred;
-{
- /* check whether we already have a GA for this local closure */
- GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) closure);
- /* create an entry in the LAGA table */
- GALA *newGALA = allocIndirection(closure);
- StgWord pga = PackGA(thisPE, newGALA->ga.payload.gc.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
- ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
-
- /* global statistics gathering */
- if (RtsFlags.ParFlags.ParStats.Global &&
- RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
- globalParStats.local_alloc_GA++;
- }
-
- newGALA->la = (StgPtr)closure;
- newGALA->preferred = preferred;
-
- if (preferred) {
- /* The new GA is now the preferred GA for the LA */
- if (oldGALA != NULL) {
- oldGALA->preferred = rtsFalse;
- (void) removeHashTable(LAtoGALAtable, (StgWord) closure, (void *) oldGALA);
- }
- insertHashTable(LAtoGALAtable, (StgWord) closure, (void *) newGALA);
- }
-
- ASSERT(!isOnLiveIndTable(&(newGALA->ga)));
- /* put the new GALA entry on the list of live indirections */
- newGALA->next = liveIndirections;
- liveIndirections = newGALA;
-
- 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
- liveRemoteGAs 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_closure, remote_ga, preferred)
-StgClosure *local_closure;
-globalAddr *remote_ga;
-rtsBool preferred;
-{
- /* old entry ie the one with the GA generated when sending off the closure */
- GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) local_closure);
- /* alloc new entry and fill it with contents of the newly arrives GA */
- GALA *newGALA = allocGALA();
- StgWord pga = PackGA(taskIDtoPE(remote_ga->payload.gc.gtid),
- remote_ga->payload.gc.slot);
-
- ASSERT(remote_ga->payload.gc.gtid != mytid);
- ASSERT(remote_ga->weight > 0);
- ASSERT(GALAlookup(remote_ga) == NULL);
-
- newGALA->ga = *remote_ga;
- newGALA->la = (StgPtr)local_closure;
- newGALA->preferred = preferred;
-
- if (preferred) {
- /* The new GA is now the preferred GA for the LA */
- if (oldGALA != NULL) {
- oldGALA->preferred = rtsFalse;
- (void) removeHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) oldGALA);
- }
- insertHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) newGALA);
- }
-
- ASSERT(!isOnRemoteGATable(&(newGALA->ga)));
- /* add new entry to the (logical) RemoteGA table */
- newGALA->next = liveRemoteGAs;
- liveRemoteGAs = newGALA;
-
- insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
-
- /*
- 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);
-}
-
-/*
- Give me a bit of weight to give away on a new reference to a particular
- global address. If we run down to nothing, we have to assign a new GA.
-*/
-
-//@cindex splitWeight
-#if 0
-void
-splitWeight(to, from)
-globalAddr *to, *from;
-{
- /* Make sure we have enough weight to split */
- if (from->weight!=MAX_GA_WEIGHT && from->weight<=3) // fixed by UK in Eden implementation
- from = makeGlobal(GALAlookup(from), rtsTrue);
-
- to->payload = from->payload;
-
- if (from->weight == MAX_GA_WEIGHT)
- to->weight = 1L << (BITS_IN(unsigned) - 1);
- else
- to->weight = from->weight / 2;
-
- from->weight -= to->weight;
-}
-#else
-void
-splitWeight(to, from)
-globalAddr *to, *from;
-{
- /* Make sure we have enough weight to split */
- /* Splitting at 2 needed, as weight 1 is not legal in packets (UK+KH) */
-
- if (from->weight / 2 <= 2) /* old: weight== 1 (UK) */
- from = makeGlobal(GALAlookup(from), rtsTrue);
-
- to->payload = from->payload;
-
- if (from->weight <= 1) /* old == 0 (UK) */
- to->weight = 1L << (BITS_IN(unsigned) - 1);
- else
- to->weight = from->weight / 2;
-
- from->weight -= to->weight;
-}
-#endif
-/*
- 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(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.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);
-}
-
-/*
- 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
-void
-initGAtables(void)
-{
- taskIDtoPEtable = allocHashTable();
- LAtoGALAtable = allocHashTable();
- pGAtoGALAtable = allocHashTable();
-}
-
-//@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
- */
-}
-
-//@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).
-*/
-//@cindex markLocalGAs
-void
-markLocalGAs(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,
- belch("@@%%%% markLocalGAs (full=%d): Marking LIVE INDIRECTIONS in GALA table starting with GALA at %p\n",
- full, liveIndirections);
- printLAGAtable());
-
- PAR_TICKY_MARK_LOCAL_GAS_START();
-
- for (gala = liveIndirections, 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.payload.gc.gtid == mytid); /* it's supposed to be local */
- if (gala->ga.weight != MAX_GA_WEIGHT) {
- /* Remote references exist, so we must evacuate the local closure */
- if (get_itbl((StgClosure *)old_la)->type == EVACUATED) {
- /* somebody else already evacuated this closure */
- new_la = (StgPtr)((StgEvacuated *)old_la)->evacuee;
- IF_PAR_DEBUG(tables,
- belch(" already evacuated to %p", new_la));
- } else {
-#if 1
- /* unwind any indirections we find */
- StgClosure *foo = UNWIND_IND((StgClosure *)old_la) ; // debugging only
- //ASSERT(HEAP_ALLOCED(foo));
- n++;
-
- new_la = (StgPtr) MarkRoot(foo);
- IF_PAR_DEBUG(tables,
- belch(" evacuated %p to %p", foo, 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);
- */
-#else
- new_la = MarkRoot(old_la); // or just evacuate(old_ga)
- IF_PAR_DEBUG(tables,
- belch(" evacuated %p to %p", old_la, new_la));
-#endif
- }
-
- gala->la = new_la;
- /* remove old LA and replace with new LA */
- if (/* !full && */ gala->preferred && new_la != old_la) {
- GALA *q;
- ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)old_la));
- (void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
- 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 {
- insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
- }
- IF_PAR_DEBUG(tables,
- belch("__## Hash table update (%p --> %p): ",
- old_la, new_la));
- }
-
- gala->next = prev;
- prev = gala;
- } else if(LOOKS_LIKE_STATIC_CLOSURE(gala->la)) {
- /* to handle the CAFs, is this all?*/
- MarkRoot(gala->la);
- IF_PAR_DEBUG(tables,
- belch(" processed static closure"));
- n++;
- gala->next = prev;
- prev = gala;
- } else {
- /* Since we have all of the weight, this GA is no longer needed */
- StgWord pga = PackGA(thisPE, gala->ga.payload.gc.slot);
-
- IF_PAR_DEBUG(free,
- belch("@@!! Freeing slot %d",
- gala->ga.payload.gc.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_) gala->la, (void *) gala);
-
- IF_DEBUG(sanity,
- gala->ga.weight = 0xdead0add;
- gala->la = (StgPtr) 0xdead00aa);
- }
- } /* for gala ... */
- liveIndirections = prev; /* list has been reversed during the marking */
-
-
- PAR_TICKY_MARK_LOCAL_GAS_END(n);
-
- IF_PAR_DEBUG(tables,
- belch("@@%%%% markLocalGAs: %d of %d GALAs marked on PE %x",
- n, m, mytid));
-}
-
-/*
- Traverse the GALA table: for every live remote GA check whether it has been
- touched during GC; if not it is not needed locally and we can free the
- closure (i.e. let go of its heap space and send a free message to the
- PE holding its GA).
- This routine has to be run AFTER doing the GC proper.
-*/
-void
-rebuildGAtables(rtsBool full)
-{
- GALA *gala, *next, *prev;
- StgClosure *closure;
- nat n = 0, size_GA = 0; // stats only (no. of GAs, and their heap size in bytes)
-
- IF_PAR_DEBUG(tables,
- belch("@@%%%% rebuildGAtables (full=%d): rebuilding LIVE REMOTE GAs in GALA table starting with GALA at %p\n",
- full, liveRemoteGAs));
-
- PAR_TICKY_REBUILD_GA_TABLES_START();
-
- prepareFreeMsgBuffers();
-
- for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
- IF_PAR_DEBUG(tables,
- printGA(&(gala->ga)));
- next = gala->next;
- ASSERT(gala->ga.payload.gc.gtid != mytid); /* it's supposed to be remote */
-
- closure = (StgClosure *) (gala->la);
- IF_PAR_DEBUG(tables,
- fprintf(stderr, " %p (%s) ",
- (StgClosure *)closure, info_type(closure)));
-
- if (/* !full && */ gala->preferred)
- (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
-
- /* Follow indirection chains to the end, just in case */
- // should conform with unwinding in markLocalGAs
- closure = UNWIND_IND(closure);
-
- /*
- If closure has been evacuated it is live; otherwise it's dead and we
- can nuke the GA attached to it in the LAGA table.
- This approach also drops global aliases for PLCs.
- */
-
- //ASSERT(!HEAP_ALLOCED(closure) || !(Bdescr((StgPtr)closure)->evacuated));
- if (get_itbl(closure)->type == EVACUATED) {
- closure = ((StgEvacuated *)closure)->evacuee;
- IF_PAR_DEBUG(tables,
- fprintf(stderr, " EVAC %p (%s)\n",
- closure, info_type(closure)));
- } else {
- /* closure is not alive any more, thus remove GA and send free msg */
- int pe = taskIDtoPE(gala->ga.payload.gc.gtid);
- StgWord pga = PackGA(pe, gala->ga.payload.gc.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",
- closure, info_type(closure), pe));
-
- (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
- freeRemoteGA(pe-1, &(gala->ga)); //-1 cause ids start at 1... not 0
- gala->next = freeGALAList;
- freeGALAList = gala;
- IF_DEBUG(sanity,
- gala->ga.weight = 0xdead0add;
- gala->la = (StgPtr)0xdead00aa);
- continue;
- }
- gala->la = (StgPtr)closure;
- if (/* !full && */ gala->preferred) {
- GALA *q;
- if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->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 ",
- gala->la, info_type((StgClosure*)gala->la));
- printGA(&(q->ga));
- fputc('\n', stderr));
- }
- } else {
- insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
- }
- }
- gala->next = prev;
- prev = gala;
- /* Global statistics: count GAs and total size
- if (RtsFlags.ParFlags.ParStats.Global &&
- RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
- StgInfoTable *info;
- nat size, ptrs, nonptrs, vhs, i;
- char str[80];
-
- info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-
- size_GA += size ;
- n++; // stats: count number of GAs we add to the new table
- }
- */
- }
- liveRemoteGAs = prev; /* list is reversed during marking */
-
- /* If we have any remaining FREE messages to send off, do so now */
- sendFreeMessages();
-
- PAR_TICKY_CNT_FREE_GA();
-
- IF_DEBUG(sanity,
- checkFreeGALAList();
- checkFreeIndirectionsList());
-
- rebuildLAGAtable();
-
-#if defined(PAR_TICKY)
- getLAGAtableSize(&n, &size_GA); // determine no of GAs and global heap
- PAR_TICKY_REBUILD_GA_TABLES_END(n, size_GA); // record these values
-#endif
-
- IF_PAR_DEBUG(tables,
- belch("@#%%%% rebuildGAtables: After ReBuilding GALA table starting with GALA at %p",
- liveRemoteGAs);
- printLAGAtable());
-}
-
-/*
- 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.
-*/
-
-//@cindex rebuildLAGAtable
-void
-rebuildLAGAtable(void)
-{
- GALA *gala;
- nat n=0, m=0; // debugging
-
- /* The old LA->GA table is worthless */
- freeHashTable(LAtoGALAtable, NULL);
- LAtoGALAtable = allocHashTable();
-
- IF_PAR_DEBUG(tables,
- belch("@@%%%% rebuildLAGAtable: new LAGA table at %p",
- LAtoGALAtable));
-
- for (gala = liveIndirections; gala != NULL; gala = gala->next) {
- n++;
- if (gala->preferred) {
- GALA *q;
- if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
- if (q->preferred && gala->preferred) {
- /* this deprecates q (see also GALAdeprecate) */
- q->preferred = rtsFalse;
- (void) removeHashTable(LAtoGALAtable, (StgWord) 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) gala->la, (void *) gala);
- }
- }
-
- for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
- m++;
- if (gala->preferred) {
- GALA *q;
- if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
- if (q->preferred && gala->preferred) {
- /* this deprecates q (see also GALAdeprecate) */
- q->preferred = rtsFalse;
- (void) removeHashTable(LAtoGALAtable, (StgWord) 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) gala->la, (void *) gala);
- }
- }
-
- IF_PAR_DEBUG(tables,
- belch("@@%%%% rebuildLAGAtable: inserted %d entries from liveIndirections and %d entries from liveRemoteGAs",
- n,m));
-}
-
-/*
- 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;
- char str[80];
- /* 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 = liveIndirections; gala != NULL; gala = gala->next) {
- closure = (StgClosure*) 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, str);
- (*sizeP) += size ; // stats: measure total heap size of global closures
- (*nP)++; // stats: count number of GAs
- }
- }
-
- for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
- closure = (StgClosure*) 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, str);
- (*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 printGA
-void
-printGA (globalAddr *ga)
-{
- fprintf(stderr, "((%x, %d, %x))",
- ga->payload.gc.gtid,
- ga->payload.gc.slot,
- ga->weight);
-}
-
-//@cindex printGALA
-void
-printGALA (GALA *gala)
-{
- printGA(&(gala->ga));
- fprintf(stderr, " -> %p (%s)",
- (StgClosure*)gala->la, info_type((StgClosure*)gala->la));
- fprintf(stderr, " %s",
- (gala->preferred) ? "PREF" : "____");
-}
-
-/*
- Printing the LA->GA table.
-*/
-
-//@cindex printLiveIndTable
-void
-printLiveIndTable(void)
-{
- GALA *gala, *q;
- nat n=0; // debugging
-
- belch("@@%%%%:: logical LiveIndTable (%p) (liveIndirections=%p):",
- LAtoGALAtable, liveIndirections);
-
- for (gala = liveIndirections; gala != NULL; gala = gala->next) {
- n++;
- printGALA(gala);
- /* check whether this gala->la is hashed into the LAGA table */
- q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
- fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ? "====" : "####");
- //ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
- }
- belch("@@%%%%:: %d live indirections",
- n);
-}
-
-void
-printRemoteGATable(void)
-{
- GALA *gala, *q;
- nat m=0; // debugging
-
- belch("@@%%%%:: logical RemoteGATable (%p) (liveRemoteGAs=%p):",
- LAtoGALAtable, liveRemoteGAs);
-
- for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
- m++;
- printGALA(gala);
- /* check whether this gala->la is hashed into the LAGA table */
- q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
- fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ? "====" : "####");
- // ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
- }
- belch("@@%%%%:: %d remote GAs",
- m);
-}
-
-//@cindex printLAGAtable
-void
-printLAGAtable(void)
-{
- belch("@@%%: LAGAtable (%p) with liveIndirections=%p, liveRemoteGAs=%p:",
- LAtoGALAtable, liveIndirections, liveRemoteGAs);
-
- printLiveIndTable();
- printRemoteGATable();
-}
-
-/*
- Check whether a GA is already in a list.
-*/
-rtsBool
-isOnLiveIndTable(globalAddr *ga)
-{
- GALA *gala;
-
- for (gala = liveIndirections; gala != NULL; gala = gala->next)
- if (gala->ga.weight==ga->weight &&
- gala->ga.payload.gc.slot==ga->payload.gc.slot &&
- gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
- return rtsTrue;
-
- return rtsFalse;
-}
-
-rtsBool
-isOnRemoteGATable(globalAddr *ga)
-{
- GALA *gala;
-
- for (gala = liveRemoteGAs; gala != NULL; gala = gala->next)
- if (gala->ga.weight==ga->weight &&
- gala->ga.payload.gc.slot==ga->payload.gc.slot &&
- gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
- 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);
- }
-}
-#endif /* PAR -- whole file */
-
-//@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
-//* liveIndirections:: @cindex\s-+liveIndirections
-//* liveRemoteGAs:: @cindex\s-+liveRemoteGAs
-//* makeGlobal:: @cindex\s-+makeGlobal
-//* markLocalGAs:: @cindex\s-+markLocalGAs
-//* 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
projects / ghc-hetmet.git / blobdiff