ghc/rts/parallel/Global.c

   1 /* ---------------------------------------------------------------------------
   2    Time-stamp: <Sat Dec 04 1999 21:28:56 Stardate: [-30]3999.47 hwloidl>
   3    $Id: Global.c,v 1.2 2000/01/13 14:34:06 hwloidl Exp $
   4
   5    (c) The AQUA/Parade Projects, Glasgow University, 1995
   6        The GdH/APART 624 Projects, Heriot-Watt University, Edinburgh, 1999
   7
   8    Global Address Manipulation.
   9
  10    The GALA and LAGA tables for mapping global addresses to local addresses
  11    (i.e. heap pointers) are defined here. We use the generic hash tables
  12    defined in Hash.c.
  13    ------------------------------------------------------------------------- */
  14
  15 #ifdef PAR /* whole file */
  16
  17 //@menu
  18 //* Includes::
  19 //* Global tables and lists::
  20 //* Fcts on GALA tables::
  21 //* Interface to taskId-PE table::
  22 //* Interface to LAGA table::
  23 //* Interface to GALA table::
  24 //* GC functions for GALA tables::
  25 //* Index::
  26 //@end menu
  27
  28 //@node Includes, Global tables and lists, Global Address Manipulation, Global Address Manipulation
  29 //@subsection Includes
  30
  31 #include "Rts.h"
  32 #include "RtsFlags.h"
  33 #include "RtsUtils.h"
  34 #include "Storage.h"
  35 #include "Hash.h"
  36 #include "ParallelRts.h"
  37
  38 /*
  39   @globalAddr@ structures are allocated in chunks to reduce malloc overhead.
  40 */
  41
  42 //@node Global tables and lists, Fcts on GALA tables, Includes, Global Address Manipulation
  43 //@subsection Global tables and lists
  44
  45 //@cindex thisPE
  46 int thisPE;
  47
  48 //@menu
  49 //* Free lists::
  50 //* Hash tables::
  51 //@end menu
  52
  53 //@node Free lists, Hash tables, Global tables and lists, Global tables and lists
  54 //@subsubsection Free lists
  55
  56 /* Free list of GALA entries */
  57 GALA *freeGALAList = NULL;
  58
  59 /* Number of globalAddr cells to allocate in one go */
  60 #define GCHUNK      (1024 * sizeof(StgWord) / sizeof(GALA))
  61
  62 /* Free list of indirections */
  63
  64 //@cindex nextIndirection
  65 static StgInt nextIndirection = 0;
  66 //@cindex freeIndirections
  67 GALA *freeIndirections = NULL;
  68
  69 /* The list of live indirections has to be marked for GC (see makeGlobal) */
  70 //@cindex liveIndirections
  71 GALA *liveIndirections = NULL;
  72
  73 /* The list of remote indirections has to be marked for GC (see setRemoteGA) */
  74 //@cindex liveRemoteGAs
  75 GALA *liveRemoteGAs = NULL;
  76
  77 //@node Hash tables,  , Free lists, Global tables and lists
  78 //@subsubsection Hash tables
  79
  80 /* Mapping global task ids PEs */
  81 //@cindex taskIDtoPEtable
  82 HashTable *taskIDtoPEtable = NULL;
  83
  84 static int nextPE = 0;
  85
  86 /* LAGA table: StgClosure* -> globalAddr*
  87                (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
  88    Mapping local to global addresses (see interface below)
  89 */
  90
  91 //@cindex LAtoGALAtable
  92 HashTable *LAtoGALAtable = NULL;
  93
  94 /* GALA table: globalAddr* -> StgClosure*
  95                (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
  96    Mapping global to local addresses (see interface below)
  97 */
  98
  99 //@cindex pGAtoGALAtable
 100 HashTable *pGAtoGALAtable = NULL;
 101
 102 //@node Fcts on GALA tables, Interface to taskId-PE table, Global tables and lists, Global Address Manipulation
 103 //@subsection Fcts on GALA tables
 104
 105 //@cindex allocGALA
 106 static GALA *
 107 allocGALA(void)
 108 {
 109   GALA *gl, *p;
 110
 111   if ((gl = freeGALAList) != NULL) {
 112     freeGALAList = gl->next;
 113   } else {
 114     gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA");
 115
 116     freeGALAList = gl + 1;
 117     for (p = freeGALAList; p < gl + GCHUNK - 1; p++)
 118       p->next = p + 1;
 119     p->next = NULL;
 120   }
 121   return gl;
 122 }
 123
 124 //@node Interface to taskId-PE table, Interface to LAGA table, Fcts on GALA tables, Global Address Manipulation
 125 //@subsection Interface to taskId-PE table
 126
 127 /*
 128   We don't really like GLOBAL_TASK_ID, so we keep a table of TASK_ID to
 129   PE mappings.  The idea is that a PE identifier will fit in 16 bits, whereas
 130   a TASK_ID may not.
 131 */
 132
 133 //@cindex taskIDtoPE
 134 PEs
 135 taskIDtoPE(GlobalTaskId gtid)
 136 {
 137   return (PEs) lookupHashTable(taskIDtoPEtable, gtid);
 138 }
 139
 140 //@cindex registerTask
 141 void
 142 registerTask(gtid)
 143 GlobalTaskId gtid;
 144 {
 145   if (gtid == mytid)
 146     thisPE = nextPE;
 147
 148   insertHashTable(taskIDtoPEtable, gtid, (void *) (StgWord) nextPE++);
 149 }
 150
 151 //@node Interface to LAGA table, Interface to GALA table, Interface to taskId-PE table, Global Address Manipulation
 152 //@subsection Interface to LAGA table
 153
 154 /*
 155   The local address to global address mapping returns a globalAddr structure
 156   (pe task id, slot, weight) for any closure in the local heap which has a
 157   global identity.  Such closures may be copies of normal form objects with
 158   a remote `master' location, @FetchMe@ nodes referencing remote objects, or
 159   globally visible objects in the local heap (for which we are the master).
 160 */
 161
 162 //@cindex LAGAlookup
 163 globalAddr *
 164 LAGAlookup(addr)
 165 StgClosure *addr;
 166 {
 167   GALA *gala;
 168
 169   /* We never look for GA's on indirections */
 170   ASSERT(IS_INDIRECTION(addr) == NULL);
 171   if ((gala = lookupHashTable(LAtoGALAtable, (StgWord) addr)) == NULL)
 172     return NULL;
 173   else
 174     return &(gala->ga);
 175 }
 176
 177 //@node Interface to GALA table, GC functions for GALA tables, Interface to LAGA table, Global Address Manipulation
 178 //@subsection Interface to GALA table
 179
 180 /*
 181   We also manage a mapping of global addresses to local addresses, so that
 182   we can ``common up'' multiple references to the same object as they arrive
 183   in data packets from remote PEs.
 184
 185   The global address to local address mapping is actually managed via a
 186   ``packed global address'' to GALA hash table.  The packed global
 187   address takes the interesting part of the @globalAddr@ structure
 188   (i.e. the pe and slot fields) and packs them into a single word
 189   suitable for hashing.
 190 */
 191
 192 //@cindex GALAlookup
 193 StgClosure *
 194 GALAlookup(ga)
 195 globalAddr *ga;
 196 {
 197   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 198   GALA *gala;
 199
 200   if ((gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga)) == NULL)
 201     return NULL;
 202   else {
 203     /*
 204      * Bypass any indirections when returning a local closure to
 205      * the caller.  Note that we do not short-circuit the entry in
 206      * the GALA tables right now, because we would have to do a
 207      * hash table delete and insert in the LAtoGALAtable to keep
 208      * that table up-to-date for preferred GALA pairs.  That's
 209      * probably a bit expensive.
 210      */
 211     return UNWIND_IND((StgClosure *)(gala->la));
 212   }
 213 }
 214
 215 /*
 216   External references to our globally-visible closures are managed through an
 217   indirection table.  The idea is that the closure may move about as the result
 218   of local garbage collections, but its global identity is determined by its
 219   slot in the indirection table, which never changes.
 220
 221   The indirection table is maintained implicitly as part of the global
 222   address to local address table.  We need only keep track of the
 223   highest numbered indirection index allocated so far, along with a free
 224   list of lower numbered indices no longer in use.
 225 */
 226
 227 /*
 228    Allocate an indirection slot for the closure currently at address @addr@.
 229 */
 230
 231 //@cindex allocIndirection
 232 static GALA *
 233 allocIndirection(StgPtr addr)
 234 {
 235   GALA *gala;
 236
 237   if ((gala = freeIndirections) != NULL) {
 238     freeIndirections = gala->next;
 239   } else {
 240     gala = allocGALA();
 241     gala->ga.payload.gc.gtid = mytid;
 242     gala->ga.payload.gc.slot = nextIndirection++;
 243   }
 244   gala->ga.weight = MAX_GA_WEIGHT;
 245   gala->la = addr;
 246   return gala;
 247 }
 248
 249 /*
 250   Make a local closure at @addr@ globally visible.  We have to allocate an
 251   indirection slot for it, and update both the local address to global address
 252   and global address to local address maps.
 253 */
 254
 255 //@cindex makeGlobal
 256 globalAddr *
 257 makeGlobal(addr, preferred)
 258 StgClosure *addr;
 259 rtsBool preferred;
 260 {
 261   GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) addr);
 262   GALA *newGALA = allocIndirection((StgPtr)addr);
 263   StgWord pga = PackGA(thisPE, newGALA->ga.payload.gc.slot);
 264
 265   ASSERT(HEAP_ALLOCED(addr)); // check that addr might point into the heap
 266   ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
 267
 268   newGALA->la = addr;
 269   newGALA->preferred = preferred;
 270
 271   if (preferred) {
 272     /* The new GA is now the preferred GA for the LA */
 273     if (oldGALA != NULL) {
 274       oldGALA->preferred = rtsFalse;
 275       (void) removeHashTable(LAtoGALAtable, (StgWord) addr, (void *) oldGALA);
 276     }
 277     insertHashTable(LAtoGALAtable, (StgWord) addr, (void *) newGALA);
 278   }
 279
 280   /* put the new GALA entry on the list of live indirections */
 281   newGALA->next = liveIndirections;
 282   liveIndirections = newGALA;
 283
 284   insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
 285
 286   return &(newGALA->ga);
 287 }
 288
 289 /*
 290   Assign an existing remote global address to an existing closure.
 291   We do not retain the @globalAddr@ structure that's passed in as an argument,
 292   so it can be a static in the calling routine.
 293 */
 294
 295 //@cindex setRemoteGA
 296 globalAddr *
 297 setRemoteGA(addr, ga, preferred)
 298 StgClosure *addr;
 299 globalAddr *ga;
 300 rtsBool preferred;
 301 {
 302   GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) addr);
 303   GALA *newGALA = allocGALA();
 304   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 305
 306   ASSERT(ga->payload.gc.gtid != mytid);
 307   ASSERT(ga->weight > 0);
 308   ASSERT(GALAlookup(ga) == NULL);
 309
 310   newGALA->ga = *ga;
 311   newGALA->la = addr;
 312   newGALA->preferred = preferred;
 313
 314   if (preferred) {
 315     /* The new GA is now the preferred GA for the LA */
 316     if (oldGALA != NULL) {
 317       oldGALA->preferred = rtsFalse;
 318       (void) removeHashTable(LAtoGALAtable, (StgWord) addr, (void *) oldGALA);
 319     }
 320     insertHashTable(LAtoGALAtable, (StgWord) addr, (void *) newGALA);
 321   }
 322   newGALA->next = liveRemoteGAs;
 323   liveRemoteGAs = newGALA;
 324
 325   insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
 326
 327   ga->weight = 0;
 328
 329   return &(newGALA->ga);
 330 }
 331
 332 /*
 333   Give me a bit of weight to give away on a new reference to a particular
 334   global address.  If we run down to nothing, we have to assign a new GA.
 335 */
 336
 337 //@cindex splitWeight
 338 void
 339 splitWeight(to, from)
 340 globalAddr *to, *from;
 341 {
 342   /* Make sure we have enough weight to split */
 343   if (from->weight == 1)
 344     from = makeGlobal(GALAlookup(from), rtsTrue);
 345
 346   to->payload = from->payload;
 347
 348   if (from->weight == 0)
 349     to->weight = 1L << (BITS_IN(unsigned) - 1);
 350   else
 351     to->weight = from->weight / 2;
 352
 353   from->weight -= to->weight;
 354 }
 355
 356 /*
 357   Here, I am returning a bit of weight that a remote PE no longer needs.
 358 */
 359
 360 //@cindex addWeight
 361 globalAddr *
 362 addWeight(ga)
 363 globalAddr *ga;
 364 {
 365   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 366   GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 367
 368   IF_PAR_DEBUG(weight,
 369                fprintf(stderr, "@* Adding weight %x to ", ga->weight);
 370                printGA(&(gala->ga));
 371                fputc('\n', stderr));
 372
 373   gala->ga.weight += ga->weight;
 374   ga->weight = 0;
 375
 376   return &(gala->ga);
 377 }
 378
 379 /*
 380   Initialize all of the global address structures: the task ID to PE id
 381   map, the local address to global address map, the global address to
 382   local address map, and the indirection table.
 383 */
 384
 385 //@cindex initGAtables
 386 void
 387 initGAtables(void)
 388 {
 389   taskIDtoPEtable = allocHashTable();
 390   LAtoGALAtable = allocHashTable();
 391   pGAtoGALAtable = allocHashTable();
 392 }
 393
 394 //@cindex PackGA
 395 StgWord
 396 PackGA (pe, slot)
 397 StgWord pe;
 398 int slot;
 399 {
 400   int pe_shift = (BITS_IN(StgWord)*3)/4;
 401   int pe_bits  = BITS_IN(StgWord) - pe_shift;
 402
 403   if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */
 404     fflush(stdout);
 405     fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",
 406             slot,pe_bits);
 407     stg_exit(EXIT_FAILURE);
 408   }
 409
 410   return((((StgWord)(pe)) << pe_shift) | ((StgWord)(slot)));
 411
 412     /* the idea is to use 3/4 of the bits (e.g., 24) for indirection-
 413        table "slot", and 1/4 for the pe# (e.g., 8).
 414
 415        We check for too many bits in "slot", and double-check (at
 416        compile-time?) that we have enough bits for "pe".  We *don't*
 417        check for too many bits in "pe", because SysMan enforces a
 418        MAX_PEs limit at the very very beginning.
 419
 420        Phil & Will 95/08
 421     */
 422 }
 423
 424 //@node GC functions for GALA tables, Debugging routines, Interface to GALA table, Global Address Manipulation
 425 //@subsection GC functions for GALA tables
 426
 427 /*
 428   When we do a copying collection, we want to evacuate all of the local
 429   entries in the GALA table for which there are outstanding remote
 430   pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
 431 */
 432 //@cindex markLocalGAs
 433 void
 434 markLocalGAs(rtsBool full)
 435 {
 436   GALA *gala;
 437   GALA *next;
 438   GALA *prev = NULL;
 439   StgPtr old_la, new_la;
 440   nat n=0, m=0; // debugging only
 441
 442   IF_DEBUG(gc,
 443            belch("@@ markLocalGAs: Marking LIVE INDIRECTIONS in GALA table starting with GALA at %p\n",
 444                  liveIndirections);
 445            printLAGAtable());
 446
 447   for (gala = liveIndirections, m=0; gala != NULL; gala = next, m++) {
 448     IF_DEBUG(gc,
 449              printGA(&(gala->ga));
 450              fprintf(stderr, ";@ %d: LA: %p (%s) ",
 451                      m, gala->la, info_type(gala->la)));
 452     next = gala->next;
 453     old_la = gala->la;
 454     ASSERT(gala->ga.payload.gc.gtid == mytid); /* it's supposed to be local */
 455     if (get_itbl((StgClosure *)old_la)->type == EVACUATED) {
 456       /* somebody else already evacuated this closure */
 457       new_la = ((StgEvacuated *)old_la)->evacuee;
 458       IF_DEBUG(gc,
 459                belch(" already evacuated to %p\n", new_la));
 460     } else {
 461       StgClosure *foo ; // debugging only
 462       n++;
 463       IF_PAR_DEBUG(verbose,
 464                    if (IS_INDIRECTION((StgClosure *)old_la))
 465                        belch("{markLocalGAs}Daq ghuH: trying to mark an indirection %p (%s) -> %p (%s); [closure=%p]",
 466                              old_la, info_type(old_la),
 467                              (foo = UNWIND_IND((StgClosure *)old_la)), info_type(foo),
 468                              old_la));
 469       new_la = MarkRoot(UNWIND_IND((StgClosure *)old_la)); // or just evacuate(old_ga)
 470       IF_DEBUG(gc,
 471                belch(" evacuated %p to %p\n", old_la, new_la));
 472     }
 473
 474     gala->la = new_la;
 475     /* remove old LA and replace with new LA */
 476     //(void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
 477     //insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
 478
 479     gala->next = prev;
 480     prev = gala;
 481   }
 482   liveIndirections = prev;  /* list has been reversed during the marking */
 483
 484   IF_PAR_DEBUG(verbose,
 485                belch("@@ markLocalGAs: %d of %d GALAs marked on PE %x",
 486                      n, m, mytid));
 487
 488   /* -------------------------------------------------------------------- */
 489
 490   n=0; m=0; // debugging only
 491
 492   IF_DEBUG(gc,
 493            belch("@@ markLocalGAs: Marking LIVE REMOTE GAs in GALA table starting with GALA at %p\n",
 494                  liveRemoteGAs));
 495
 496   for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 497     IF_DEBUG(gc,
 498              printGA(&(gala->ga)));
 499     next = gala->next;
 500     old_la = gala->la;
 501     ASSERT(gala->ga.payload.gc.gtid != mytid); /* it's supposed to be remote */
 502     if (get_itbl((StgClosure *)old_la)->type == EVACUATED) {
 503       /* somebody else already evacuated this closure */
 504       new_la = ((StgEvacuated *)old_la)->evacuee;
 505     } else {
 506       n++;
 507       new_la = MarkRoot((StgClosure *)old_la); // or just evacuate(old_ga)
 508     }
 509
 510     gala->la = new_la;
 511     /* remove old LA and replace with new LA */
 512     //(void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
 513     //insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
 514
 515     gala->next = prev;
 516     prev = gala;
 517   }
 518   liveRemoteGAs = prev; /* list is reversed during marking */
 519
 520   /* If we have any remaining FREE messages to send off, do so now */
 521   // sendFreeMessages();
 522
 523   IF_DEBUG(gc,
 524            belch("@@ markLocalGAs: GALA after marking");
 525            printLAGAtable();
 526            belch("--------------------------------------"));
 527
 528 }
 529
 530 void
 531 OLDmarkLocalGAs(rtsBool full)
 532 {
 533   extern StgClosure *MarkRootHWL(StgClosure *root);
 534
 535   GALA *gala;
 536   GALA *next;
 537   GALA *prev = NULL;
 538   StgPtr new_la;
 539   nat n=0, m=0; // debugging only
 540
 541   IF_DEBUG(gc,
 542            belch("@@ markLocalGAs: Marking entries in GALA table starting with GALA at %p",
 543                  liveIndirections);
 544            printLAGAtable());
 545
 546   for (gala = liveIndirections; gala != NULL; gala = next) {
 547     IF_DEBUG(gc,
 548              printGA(&(gala->ga));
 549              fprintf(stderr, " LA: %p (%s) ",
 550                      gala->la, info_type(gala->la)));
 551     next = gala->next;
 552     ASSERT(gala->ga.payload.gc.gtid == mytid); /* it's supposed to be local */
 553     if (gala->ga.weight != MAX_GA_WEIGHT) {
 554       /* Remote references exist, so we must evacuate the local closure */
 555       StgPtr old_la = gala->la;
 556
 557       if (get_itbl((StgClosure *)old_la)->type != EVACUATED) { // track evacuee!??
 558         n++;
 559         IF_DEBUG(gc,
 560                  fprintf(stderr, " marking as root\n"));
 561         new_la = MarkRoot((StgClosure *)old_la); // or just evacuate(old_ga)
 562         //IF_DEBUG(gc,
 563         //       fprintf(stderr, " new LA is %p ", new_la));
 564         if (!full && gala->preferred && new_la != old_la) {
 565           IF_DEBUG(gc,
 566                    fprintf(stderr, " replacing %p with %p in LAGA table\n",
 567                            old_la, new_la));
 568           (void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
 569           insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
 570         }
 571       } else {
 572         IF_DEBUG(gc,
 573                  fprintf(stderr, " EVAC "));
 574         new_la = ((StgEvacuated *)old_la)->evacuee;
 575         IF_DEBUG(gc,
 576                  fprintf(stderr, " replacing %p with %p in LAGA table\n",
 577                            old_la, new_la));
 578         (void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
 579         insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
 580       }
 581       gala->next = prev;
 582       prev = gala;
 583     } else {
 584       /* Since we have all of the weight, this GA is no longer needed */
 585       StgWord pga = PackGA(thisPE, gala->ga.payload.gc.slot);
 586
 587       m++;
 588       IF_DEBUG(gc,
 589                fprintf(stderr, " freeing slot %d",
 590                        gala->ga.payload.gc.slot));
 591
 592       /* put the now redundant GALA onto the free list */
 593       gala->next = freeIndirections;
 594       freeIndirections = gala;
 595       /* remove the GALA from the GALA table; now it's just local */
 596       (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 597       if (!full && gala->preferred)
 598         (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 599
 600 #ifdef DEBUG
 601       gala->ga.weight = 0x0d0d0d0d;
 602       gala->la = (StgWord) 0x0bad0bad;
 603 #endif
 604     }
 605   }
 606   liveIndirections = prev;  /* list has been reversed during the marking */
 607
 608   IF_PAR_DEBUG(verbose,
 609                belch("@@ markLocalGAs: %d GALAs marked, %d GALAs nuked on PE %x",
 610                      n, m, mytid));
 611
 612 }
 613
 614 //@cindex RebuildGAtables
 615 void
 616 RebuildGAtables(rtsBool full)
 617 {
 618   GALA *gala;
 619   GALA *next;
 620   GALA *prev;
 621   StgClosure *closure, *last, *new_closure;
 622
 623   //prepareFreeMsgBuffers();
 624
 625   if (full)
 626     RebuildLAGAtable();
 627
 628   IF_DEBUG(gc,
 629            belch("@@ RebuildGAtables: After ReBuilding GALA table starting with GALA at %p",
 630                  liveRemoteGAs);
 631            printLAGAtable());
 632 }
 633
 634 void
 635 OLDRebuildGAtables(rtsBool full)
 636 {
 637   GALA *gala;
 638   GALA *next;
 639   GALA *prev;
 640   StgClosure *closure, *last, *new_closure;
 641
 642   prepareFreeMsgBuffers();
 643
 644   for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 645     IF_DEBUG(gc,
 646              printGA(&(gala->ga)));
 647     next = gala->next;
 648     ASSERT(gala->ga.payload.gc.gtid != mytid); /* it's supposed to be remote */
 649
 650     closure = (StgClosure *) (gala->la);
 651
 652     /*
 653      * If the old closure has not been forwarded, we let go.  Note that this
 654      * approach also drops global aliases for PLCs.
 655      */
 656
 657     if (!full && gala->preferred)
 658       (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 659
 660     /* Follow indirection chains to the end, just in case */
 661     closure = UNWIND_IND(closure);
 662
 663     /*
 664     if (get_itbl(closure)->type != EVACUATED) { // (new_closure = isAlive(closure)) == NULL) { // (W_) Forward_Ref_info)
 665       // closure is not alive any more, thus remove GA
 666       int pe = taskIDtoPE(gala->ga.payload.gc.gtid);
 667       StgWord pga = PackGA(pe, gala->ga.payload.gc.slot);
 668
 669       IF_DEBUG(gc,
 670                fprintf(stderr, " (LA: %p (%s)) is unused on this PE -> sending free\n",
 671                        closure, info_type(closure)));
 672
 673       (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 674       freeRemoteGA(pe, &(gala->ga));
 675       gala->next = freeGALAList;
 676       freeGALAList = gala;
 677     } else {
 678     */
 679     if (get_itbl(closure)->type == EVACUATED) {
 680       IF_DEBUG(gc,
 681                fprintf(stderr, " EVAC %p (%s)\n",
 682                        closure, info_type(closure)));
 683       closure = ((StgEvacuated *)closure)->evacuee;
 684     } else {
 685       IF_DEBUG(gc,
 686                fprintf(stderr, " !EVAC %p (%s)\n",
 687                        closure, info_type(closure)));
 688     }
 689     gala->la = closure;
 690     if (!full && gala->preferred)
 691       insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 692     gala->next = prev;
 693     prev = gala;
 694   }
 695   //}
 696   liveRemoteGAs = prev; /* list is reversed during marking */
 697
 698   /* If we have any remaining FREE messages to send off, do so now */
 699   sendFreeMessages();
 700
 701   if (full)
 702     RebuildLAGAtable();
 703
 704   IF_DEBUG(gc,
 705            belch("@@ RebuildGAtables: After ReBuilding GALA table starting with GALA at %p",
 706                  liveRemoteGAs);
 707            printLAGAtable());
 708 }
 709
 710 /*
 711   Rebuild the LA->GA table, assuming that the addresses in the GALAs are
 712   correct.
 713 */
 714
 715 //@cindex RebuildLAGAtable
 716 void
 717 RebuildLAGAtable(void)
 718 {
 719   GALA *gala;
 720   nat n=0, m=0; // debugging
 721
 722   /* The old LA->GA table is worthless */
 723   freeHashTable(LAtoGALAtable, NULL);
 724   LAtoGALAtable = allocHashTable();
 725
 726   IF_DEBUG(gc,
 727            belch("@@ RebuildLAGAtable: new LAGA table at %p",
 728                  LAtoGALAtable));
 729
 730   for (gala = liveIndirections; gala != NULL; gala = gala->next) {
 731     n++;
 732     if (gala->preferred)
 733       insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 734   }
 735
 736   for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
 737     m++;
 738     if (gala->preferred)
 739       insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 740   }
 741
 742   IF_DEBUG(gc,
 743            belch("@@ RebuildLAGAtable: inserted %d entries from liveIndirections and %d entries from liveRemoteGAs",
 744                  n,m));
 745
 746 }
 747
 748 //@node Debugging routines, Index, GC functions for GALA tables, Global Address Manipulation
 749 //@subsection Debugging routines
 750
 751 //@cindex printGA
 752 void
 753 printGA (globalAddr *ga)
 754 {
 755   fprintf(stderr, "((%x, %d, %x))",
 756           ga->payload.gc.gtid,
 757           ga->payload.gc.slot,
 758           ga->weight);
 759 }
 760
 761 //@cindex printGALA
 762 void
 763 printGALA (GALA *gala)
 764 {
 765   printGA(&(gala->ga));
 766   fprintf(stderr, " -> %p (%s)", (StgPtr)gala->la, info_type(gala->la));
 767   fprintf(stderr, " %s", (gala->preferred) ? "PREF" : "____");
 768 }
 769
 770 /*
 771   Printing the LA->GA table.
 772 */
 773
 774 //@cindex DebugPrintLAGAtable
 775 void
 776 printLAGAtable(void)
 777 {
 778   GALA *gala;
 779   nat n=0, m=0; // debugging
 780
 781   belch("@@ LAGAtable (%p) with liveIndirections=%p, liveRemoteGAs=%p:",
 782         LAtoGALAtable, liveIndirections, liveRemoteGAs);
 783
 784   for (gala = liveIndirections; gala != NULL; gala = gala->next) {
 785     n++;
 786     printGALA(gala);
 787     fputc('\n', stderr);
 788   }
 789
 790   for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
 791     m++;
 792     printGALA(gala);
 793     fputc('\n', stderr);
 794   }
 795   belch("@@ LAGAtable has %d liveIndirections entries and %d liveRemoteGAs entries",
 796         n, m);
 797 }
 798
 799 #endif /* PAR -- whole file */
 800
 801 //@node Index,  , Debugging routines, Global Address Manipulation
 802 //@subsection Index
 803
 804 //@index
 805 //* GALAlookup::  @cindex\s-+GALAlookup
 806 //* LAGAlookup::  @cindex\s-+LAGAlookup
 807 //* LAtoGALAtable::  @cindex\s-+LAtoGALAtable
 808 //* PackGA::  @cindex\s-+PackGA
 809 //* RebuildGAtables::  @cindex\s-+RebuildGAtables
 810 //* RebuildLAGAtable::  @cindex\s-+RebuildLAGAtable
 811 //* addWeight::  @cindex\s-+addWeight
 812 //* allocGALA::  @cindex\s-+allocGALA
 813 //* allocIndirection::  @cindex\s-+allocIndirection
 814 //* freeIndirections::  @cindex\s-+freeIndirections
 815 //* initGAtables::  @cindex\s-+initGAtables
 816 //* liveIndirections::  @cindex\s-+liveIndirections
 817 //* liveRemoteGAs::  @cindex\s-+liveRemoteGAs
 818 //* makeGlobal::  @cindex\s-+makeGlobal
 819 //* markLocalGAs::  @cindex\s-+markLocalGAs
 820 //* nextIndirection::  @cindex\s-+nextIndirection
 821 //* pGAtoGALAtable::  @cindex\s-+pGAtoGALAtable
 822 //* registerTask::  @cindex\s-+registerTask
 823 //* setRemoteGA::  @cindex\s-+setRemoteGA
 824 //* splitWeight::  @cindex\s-+splitWeight
 825 //* taskIDtoPE::  @cindex\s-+taskIDtoPE
 826 //* taskIDtoPEtable::  @cindex\s-+taskIDtoPEtable
 827 //* thisPE::  @cindex\s-+thisPE
 828 //@end index