path: root/ghc/rts/parallel/Global.c

/* ---------------------------------------------------------------------------
   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