summaryrefslogtreecommitdiff
path: root/ghc/rts/parallel/Global.c
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
commit0065d5ab628975892cea1ec7303f968c3338cbe1 (patch)
tree8e2afe0ab48ee33cf95009809d67c9649573ef92 /ghc/rts/parallel/Global.c
parent28a464a75e14cece5db40f2765a29348273ff2d2 (diff)
downloadhaskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to Cabal, and with the move to darcs we can now flatten the source tree without losing history, so here goes. The main change is that the ghc/ subdir is gone, and most of what it contained is now at the top level. The build system now makes no pretense at being multi-project, it is just the GHC build system. No doubt this will break many things, and there will be a period of instability while we fix the dependencies. A straightforward build should work, but I haven't yet fixed binary/source distributions. Changes to the Building Guide will follow, too.
Diffstat (limited to 'ghc/rts/parallel/Global.c')
-rw-r--r--ghc/rts/parallel/Global.c1090
1 files changed, 0 insertions, 1090 deletions
diff --git a/ghc/rts/parallel/Global.c b/ghc/rts/parallel/Global.c
deleted file mode 100644
index b2541357e1..0000000000
--- a/ghc/rts/parallel/Global.c
+++ /dev/null
@@ -1,1090 +0,0 @@
-/* ---------------------------------------------------------------------------
- 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