ghc/rts/parallel/Global.c

   1 /* ---------------------------------------------------------------------------
   2    Time-stamp: <Mon Mar 27 2000 17:10:57 Stardate: [-30]4568.37 hwloidl>
   3    $Id: Global.c,v 1.3 2000/03/31 03:09:37 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 #if defined(DIST)
  38 #include "Dist.h"
  39 #endif
  40
  41 /*
  42   @globalAddr@ structures are allocated in chunks to reduce malloc overhead.
  43 */
  44
  45 //@node Global tables and lists, Fcts on GALA tables, Includes, Global Address Manipulation
  46 //@subsection Global tables and lists
  47
  48 //@cindex thisPE
  49 nat thisPE;
  50
  51 //@menu
  52 //* Free lists::
  53 //* Hash tables::
  54 //@end menu
  55
  56 //@node Free lists, Hash tables, Global tables and lists, Global tables and lists
  57 //@subsubsection Free lists
  58
  59 /* Free list of GALA entries */
  60 GALA *freeGALAList = NULL;
  61
  62 /* Number of globalAddr cells to allocate in one go */
  63 #define GCHUNK      (1024 * sizeof(StgWord) / sizeof(GALA))
  64
  65 /* Free list of indirections */
  66
  67 //@cindex nextIndirection
  68 static StgInt nextIndirection = 0;
  69 //@cindex freeIndirections
  70 GALA *freeIndirections = NULL;
  71
  72 /* The list of live indirections has to be marked for GC (see makeGlobal) */
  73 //@cindex liveIndirections
  74 GALA *liveIndirections = NULL;
  75
  76 /* The list of remote indirections has to be marked for GC (see setRemoteGA) */
  77 //@cindex liveRemoteGAs
  78 GALA *liveRemoteGAs = NULL;
  79
  80 //@node Hash tables,  , Free lists, Global tables and lists
  81 //@subsubsection Hash tables
  82
  83 /* Mapping global task ids PEs */
  84 //@cindex taskIDtoPEtable
  85 HashTable *taskIDtoPEtable = NULL;
  86
  87 static int nextPE = 0;
  88
  89 /* LAGA table: StgClosure* -> globalAddr*
  90                (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
  91    Mapping local to global addresses (see interface below)
  92 */
  93
  94 //@cindex LAtoGALAtable
  95 HashTable *LAtoGALAtable = NULL;
  96
  97 /* GALA table: globalAddr* -> StgClosure*
  98                (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
  99    Mapping global to local addresses (see interface below)
 100 */
 101
 102 //@cindex pGAtoGALAtable
 103 HashTable *pGAtoGALAtable = NULL;
 104
 105 //@node Fcts on GALA tables, Interface to taskId-PE table, Global tables and lists, Global Address Manipulation
 106 //@subsection Fcts on GALA tables
 107
 108 //@cindex allocGALA
 109 static GALA *
 110 allocGALA(void)
 111 {
 112   GALA *gl, *p;
 113
 114   if ((gl = freeGALAList) != NULL) {
 115     IF_DEBUG(sanity,
 116              ASSERT(gl->ga.weight==0xdead0add);
 117              ASSERT(gl->la==0xdead00aa));
 118     freeGALAList = gl->next;
 119   } else {
 120     gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA");
 121
 122     freeGALAList = gl + 1;
 123     for (p = freeGALAList; p < gl + GCHUNK - 1; p++) {
 124       p->next = p + 1;
 125       IF_DEBUG(sanity,
 126                p->ga.weight=0xdead0add;
 127                p->la=0xdead00aa);
 128     }
 129     /* last elem in the new block has NULL pointer in link field */
 130     p->next = NULL;
 131     IF_DEBUG(sanity,
 132              p->ga.weight=0xdead0add;
 133              p->la=0xdead00aa);
 134   }
 135   IF_DEBUG(sanity,
 136            gl->ga.weight=0xdead0add;
 137            gl->la=0xdead00aa);
 138   return gl;
 139 }
 140
 141 //@node Interface to taskId-PE table, Interface to LAGA table, Fcts on GALA tables, Global Address Manipulation
 142 //@subsection Interface to taskId-PE table
 143
 144 /*
 145   We don't really like GLOBAL_TASK_ID, so we keep a table of TASK_ID to
 146   PE mappings.  The idea is that a PE identifier will fit in 16 bits, whereas
 147   a TASK_ID may not.
 148 */
 149
 150 //@cindex taskIDtoPE
 151 PEs
 152 taskIDtoPE(GlobalTaskId gtid)
 153 {
 154   return (PEs) lookupHashTable(taskIDtoPEtable, gtid);
 155 }
 156
 157 //@cindex registerTask
 158 void
 159 registerTask(gtid)
 160 GlobalTaskId gtid;
 161 {
 162   if (gtid == mytid)
 163     thisPE = nextPE;
 164
 165   insertHashTable(taskIDtoPEtable, gtid, (void *) (StgWord) nextPE++);
 166 }
 167
 168 //@node Interface to LAGA table, Interface to GALA table, Interface to taskId-PE table, Global Address Manipulation
 169 //@subsection Interface to LAGA table
 170
 171 /*
 172   The local address to global address mapping returns a globalAddr structure
 173   (pe task id, slot, weight) for any closure in the local heap which has a
 174   global identity.  Such closures may be copies of normal form objects with
 175   a remote `master' location, @FetchMe@ nodes referencing remote objects, or
 176   globally visible objects in the local heap (for which we are the master).
 177 */
 178
 179 //@cindex LAGAlookup
 180 globalAddr *
 181 LAGAlookup(addr)
 182 StgClosure *addr;
 183 {
 184   GALA *gala;
 185
 186   /* We never look for GA's on indirections. -- unknown hacker
 187      Well, in fact at the moment we do in the new RTS. -- HWL
 188      ToDo: unwind INDs when entering them into the hash table
 189
 190   ASSERT(IS_INDIRECTION(addr) == NULL);
 191   */
 192   if ((gala = lookupHashTable(LAtoGALAtable, (StgWord) addr)) == NULL)
 193     return NULL;
 194   else
 195     return &(gala->ga);
 196 }
 197
 198 //@node Interface to GALA table, GC functions for GALA tables, Interface to LAGA table, Global Address Manipulation
 199 //@subsection Interface to GALA table
 200
 201 /*
 202   We also manage a mapping of global addresses to local addresses, so that
 203   we can ``common up'' multiple references to the same object as they arrive
 204   in data packets from remote PEs.
 205
 206   The global address to local address mapping is actually managed via a
 207   ``packed global address'' to GALA hash table.  The packed global
 208   address takes the interesting part of the @globalAddr@ structure
 209   (i.e. the pe and slot fields) and packs them into a single word
 210   suitable for hashing.
 211 */
 212
 213 //@cindex GALAlookup
 214 StgClosure *
 215 GALAlookup(ga)
 216 globalAddr *ga;
 217 {
 218   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 219   GALA *gala;
 220
 221   if ((gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga)) == NULL)
 222     return NULL;
 223   else {
 224     /*
 225      * Bypass any indirections when returning a local closure to
 226      * the caller.  Note that we do not short-circuit the entry in
 227      * the GALA tables right now, because we would have to do a
 228      * hash table delete and insert in the LAtoGALAtable to keep
 229      * that table up-to-date for preferred GALA pairs.  That's
 230      * probably a bit expensive.
 231      */
 232     return UNWIND_IND((StgClosure *)(gala->la));
 233   }
 234 }
 235
 236 /* ga becomes non-preferred (e.g. due to CommonUp) */
 237 void
 238 GALAdeprecate(ga)
 239 globalAddr *ga;
 240 {
 241   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 242   GALA *gala;
 243
 244   gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 245   ASSERT(gala!=NULL);
 246   ASSERT(gala->preferred==rtsTrue);
 247   gala->preferred==rtsFalse;
 248 }
 249
 250 /*
 251   External references to our globally-visible closures are managed through an
 252   indirection table.  The idea is that the closure may move about as the result
 253   of local garbage collections, but its global identity is determined by its
 254   slot in the indirection table, which never changes.
 255
 256   The indirection table is maintained implicitly as part of the global
 257   address to local address table.  We need only keep track of the
 258   highest numbered indirection index allocated so far, along with a free
 259   list of lower numbered indices no longer in use.
 260 */
 261
 262 /*
 263    Allocate an indirection slot for the closure currently at address @addr@.
 264 */
 265
 266 //@cindex allocIndirection
 267 static GALA *
 268 allocIndirection(StgClosure *closure)
 269 {
 270   GALA *gala;
 271
 272   if ((gala = freeIndirections) != NULL) {
 273     IF_DEBUG(sanity,
 274              ASSERT(gala->ga.weight==0xdead0add);
 275              ASSERT(gala->la==0xdead00aa));
 276     freeIndirections = gala->next;
 277   } else {
 278     gala = allocGALA();
 279     IF_DEBUG(sanity,
 280              ASSERT(gala->ga.weight==0xdead0add);
 281              ASSERT(gala->la==0xdead00aa));
 282     gala->ga.payload.gc.gtid = mytid;
 283     gala->ga.payload.gc.slot = nextIndirection++;
 284   }
 285   gala->ga.weight = MAX_GA_WEIGHT;
 286   gala->la = closure;
 287   IF_DEBUG(sanity,
 288            gala->next=0xcccccccc);
 289   return gala;
 290 }
 291
 292 /*
 293    This is only used for sanity checking (see LOOKS_LIKE_SLOT)
 294 */
 295 StgInt
 296 highest_slot (void) { return nextIndirection; }
 297
 298 /*
 299   Make a local closure globally visible.
 300
 301   Called from: GlobaliseAndPackGA
 302   Args:
 303    closure ... closure to be made visible
 304    preferred ... should the new GA become the preferred one (normalle=y true)
 305
 306   Allocate a GALA structure and add it to the (logical) Indirections table,
 307   by inserting it into the LAtoGALAtable hash table and putting it onto the
 308   liveIndirections list (only if it is preferred).
 309
 310   We have to allocate an indirection slot for it, and update both the local
 311   address to global address and global address to local address maps.
 312 */
 313
 314 //@cindex makeGlobal
 315 globalAddr *
 316 makeGlobal(closure, preferred)
 317 StgClosure *closure;
 318 rtsBool preferred;
 319 {
 320   /* check whether we already have a GA for this local closure */
 321   GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) closure);
 322   /* create an entry in the LAGA table */
 323   GALA *newGALA = allocIndirection((StgPtr)closure);
 324   StgWord pga = PackGA(thisPE, newGALA->ga.payload.gc.slot);
 325
 326   IF_DEBUG(sanity,
 327            ASSERT(newGALA->next==0xcccccccc););
 328   // ASSERT(HEAP_ALLOCED(closure)); // check that closure might point into the heap; might be static, though
 329   ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
 330
 331   newGALA->la = closure;
 332   newGALA->preferred = preferred;
 333
 334   if (preferred) {
 335     /* The new GA is now the preferred GA for the LA */
 336     if (oldGALA != NULL) {
 337       oldGALA->preferred = rtsFalse;
 338       (void) removeHashTable(LAtoGALAtable, (StgWord) closure, (void *) oldGALA);
 339     }
 340     insertHashTable(LAtoGALAtable, (StgWord) closure, (void *) newGALA);
 341   }
 342
 343   ASSERT(!isOnLiveIndTable(&(newGALA->ga)));
 344   /* put the new GALA entry on the list of live indirections */
 345   newGALA->next = liveIndirections;
 346   liveIndirections = newGALA;
 347
 348   insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
 349
 350   return &(newGALA->ga);
 351 }
 352
 353 /*
 354   Assign an existing remote global address to an existing closure.
 355
 356   Called from: Unpack in Pack.c
 357   Args:
 358    local_closure ... a closure that has just been unpacked
 359    remote_ga ... the GA that came with it, ie. the name under which the
 360                  closure is known while being transferred
 361    preferred ... should the new GA become the preferred one (normalle=y true)
 362
 363   Allocate a GALA structure and add it to the (logical) RemoteGA table,
 364   by inserting it into the LAtoGALAtable hash table and putting it onto the
 365   liveRemoteGAs list (only if it is preferred).
 366
 367   We do not retain the @globalAddr@ structure that's passed in as an argument,
 368   so it can be a static in the calling routine.
 369 */
 370
 371 //@cindex setRemoteGA
 372 globalAddr *
 373 setRemoteGA(local_closure, remote_ga, preferred)
 374 StgClosure *local_closure;
 375 globalAddr *remote_ga;
 376 rtsBool preferred;
 377 {
 378   /* old entry ie the one with the GA generated when sending off the closure */
 379   GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) local_closure);
 380   /* alloc new entry and fill it with contents of the newly arrives GA */
 381   GALA *newGALA = allocGALA();
 382   StgWord pga = PackGA(taskIDtoPE(remote_ga->payload.gc.gtid),
 383                        remote_ga->payload.gc.slot);
 384
 385   ASSERT(remote_ga->payload.gc.gtid != mytid);
 386   ASSERT(remote_ga->weight > 0);
 387   ASSERT(GALAlookup(remote_ga) == NULL);
 388
 389   newGALA->ga = *remote_ga;
 390   newGALA->la = local_closure;
 391   newGALA->preferred = preferred;
 392
 393   if (preferred) {
 394     /* The new GA is now the preferred GA for the LA */
 395     if (oldGALA != NULL) {
 396       oldGALA->preferred = rtsFalse;
 397       (void) removeHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) oldGALA);
 398     }
 399     insertHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) newGALA);
 400   }
 401
 402   ASSERT(!isOnRemoteGATable(&(newGALA->ga)));
 403   /* add new entry to the (logical) RemoteGA table */
 404   newGALA->next = liveRemoteGAs;
 405   liveRemoteGAs = newGALA;
 406
 407   insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
 408
 409   /*
 410     The weight carried by the incoming closure is transferred to the newGALA
 411     entry (via the structure assign above). Therefore, we have to give back
 412     the weight to the GA on the other processor, because that indirection is
 413     no longer needed.
 414   */
 415   remote_ga->weight = 0;
 416   return &(newGALA->ga);
 417 }
 418
 419 /*
 420   Give me a bit of weight to give away on a new reference to a particular
 421   global address.  If we run down to nothing, we have to assign a new GA.
 422 */
 423
 424 //@cindex splitWeight
 425 #if 0
 426 void
 427 splitWeight(to, from)
 428 globalAddr *to, *from;
 429 {
 430   /* Make sure we have enough weight to split */
 431   if (from->weight!=MAX_GA_WEIGHT && from->weight<=3)  // fixed by UK in Eden implementation
 432     from = makeGlobal(GALAlookup(from), rtsTrue);
 433
 434   to->payload = from->payload;
 435
 436   if (from->weight == MAX_GA_WEIGHT)
 437     to->weight = 1L << (BITS_IN(unsigned) - 1);
 438   else
 439     to->weight = from->weight / 2;
 440
 441   from->weight -= to->weight;
 442 }
 443 #else
 444 void
 445 splitWeight(to, from)
 446 globalAddr *to, *from;
 447 {
 448   /* Make sure we have enough weight to split */
 449   /* Splitting at 2 needed, as weight 1 is not legal in packets (UK+KH) */
 450
 451   if (from->weight / 2 <= 2) /* old: weight== 1 (UK) */
 452       from = makeGlobal(GALAlookup(from), rtsTrue);
 453
 454   to->payload = from->payload;
 455
 456   if (from->weight <= 1) /* old == 0 (UK) */
 457       to->weight = 1L << (BITS_IN(unsigned) - 1);
 458   else
 459       to->weight = from->weight / 2;
 460
 461   from->weight -= to->weight;
 462 }
 463 #endif
 464 /*
 465   Here, I am returning a bit of weight that a remote PE no longer needs.
 466 */
 467
 468 //@cindex addWeight
 469 globalAddr *
 470 addWeight(ga)
 471 globalAddr *ga;
 472 {
 473   StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
 474   GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 475
 476   IF_PAR_DEBUG(weight,
 477                fprintf(stderr, "@* Adding weight %x to ", ga->weight);
 478                printGA(&(gala->ga));
 479                fputc('\n', stderr));
 480
 481   gala->ga.weight += ga->weight;
 482   ga->weight = 0;
 483
 484   return &(gala->ga);
 485 }
 486
 487 /*
 488   Initialize all of the global address structures: the task ID to PE id
 489   map, the local address to global address map, the global address to
 490   local address map, and the indirection table.
 491 */
 492
 493 //@cindex initGAtables
 494 void
 495 initGAtables(void)
 496 {
 497   taskIDtoPEtable = allocHashTable();
 498   LAtoGALAtable = allocHashTable();
 499   pGAtoGALAtable = allocHashTable();
 500 #ifdef DIST
 501   stickyClosureTable = allocHashTable();
 502 #endif
 503 }
 504
 505 //@cindex PackGA
 506 StgWord
 507 PackGA (pe, slot)
 508 StgWord pe;
 509 int slot;
 510 {
 511   int pe_shift = (BITS_IN(StgWord)*3)/4;
 512   int pe_bits  = BITS_IN(StgWord) - pe_shift;
 513
 514   if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */
 515     fflush(stdout);
 516     fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",
 517             slot,pe_bits);
 518     stg_exit(EXIT_FAILURE);
 519   }
 520
 521   return((((StgWord)(pe)) << pe_shift) | ((StgWord)(slot)));
 522
 523     /* the idea is to use 3/4 of the bits (e.g., 24) for indirection-
 524        table "slot", and 1/4 for the pe# (e.g., 8).
 525
 526        We check for too many bits in "slot", and double-check (at
 527        compile-time?) that we have enough bits for "pe".  We *don't*
 528        check for too many bits in "pe", because SysMan enforces a
 529        MAX_PEs limit at the very very beginning.
 530
 531        Phil & Will 95/08
 532     */
 533 }
 534
 535 //@node GC functions for GALA tables, Debugging routines, Interface to GALA table, Global Address Manipulation
 536 //@subsection GC functions for GALA tables
 537
 538 /*
 539   When we do a copying collection, we want to evacuate all of the local
 540   entries in the GALA table for which there are outstanding remote
 541   pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
 542   This routine has to be run BEFORE doing the GC proper (it's a
 543   ``mark roots'' thing).
 544 */
 545 //@cindex markLocalGAs
 546 void
 547 markLocalGAs(rtsBool full)
 548 {
 549   GALA *gala;
 550   GALA *next;
 551   GALA *prev = NULL;
 552   StgPtr old_la, new_la;
 553   nat n=0, m=0; // debugging only
 554
 555   IF_PAR_DEBUG(tables,
 556            belch("@@%%%% markLocalGAs: Marking LIVE INDIRECTIONS in GALA table starting with GALA at %p\n",
 557                  liveIndirections);
 558            printLAGAtable());
 559
 560   for (gala = liveIndirections, m=0; gala != NULL; gala = next, m++) {
 561     IF_PAR_DEBUG(tables,
 562                  fputs("@@ ",stderr);
 563                  printGA(&(gala->ga));
 564                  fprintf(stderr, ";@ %d: LA: %p (%s) ",
 565                          m, gala->la, info_type(gala->la)));
 566     next = gala->next;
 567     old_la = gala->la;
 568     ASSERT(gala->ga.payload.gc.gtid == mytid); /* it's supposed to be local */
 569     if (gala->ga.weight != MAX_GA_WEIGHT) {
 570       /* Remote references exist, so we must evacuate the local closure */
 571       if (get_itbl((StgClosure *)old_la)->type == EVACUATED) {
 572         /* somebody else already evacuated this closure */
 573         new_la = ((StgEvacuated *)old_la)->evacuee;
 574         IF_PAR_DEBUG(tables,
 575                  belch(" already evacuated to %p", new_la));
 576       } else {
 577 #if 1
 578         /* unwind any indirections we find */
 579         StgClosure *foo = UNWIND_IND((StgClosure *)old_la) ; // debugging only
 580         //ASSERT(HEAP_ALLOCED(foo));
 581         n++;
 582
 583         new_la = MarkRoot(foo); // or just evacuate(old_ga)
 584         IF_PAR_DEBUG(tables,
 585                      belch(" evacuated %p to %p", foo, new_la));
 586         //ASSERT(Bdescr(new_la)->evacuated);
 587 #else
 588         new_la = MarkRoot(old_la); // or just evacuate(old_ga)
 589         IF_PAR_DEBUG(tables,
 590                      belch(" evacuated %p to %p", old_la, new_la));
 591 #endif
 592       }
 593
 594       gala->la = new_la;
 595       /* remove old LA and replace with new LA */
 596       if (!full && gala->preferred && new_la != old_la) {
 597         GALA *q;
 598         ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)old_la));
 599         (void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
 600         if ((q = lookupHashTable(LAtoGALAtable, (StgWord) new_la))!=NULL) {
 601           if (q->preferred && gala->preferred) {
 602             q->preferred = rtsFalse;
 603             IF_PAR_DEBUG(tables,
 604                          fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
 605                            new_la, info_type(new_la));
 606                          printGA(&(q->ga));
 607                          fputc('\n', stderr));
 608           }
 609         } else {
 610           insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
 611         }
 612         IF_PAR_DEBUG(tables,
 613                  belch("__## Hash table update (%p --> %p): ",
 614                        old_la, new_la));
 615       }
 616
 617       gala->next = prev;
 618       prev = gala;
 619     } else {
 620       /* Since we have all of the weight, this GA is no longer needed */
 621       StgWord pga = PackGA(thisPE, gala->ga.payload.gc.slot);
 622
 623       IF_PAR_DEBUG(free,
 624                    belch("@@!! Freeing slot %d",
 625                          gala->ga.payload.gc.slot));
 626       /* put gala on free indirections list */
 627       gala->next = freeIndirections;
 628       freeIndirections = gala;
 629       (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 630       if (!full && gala->preferred)
 631         (void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 632
 633       IF_DEBUG(sanity,
 634                gala->ga.weight = 0xdead0add;
 635                gala->la = (StgClosure *) 0xdead00aa);
 636     }
 637   } /* for gala ... */
 638   liveIndirections = prev;  /* list has been reversed during the marking */
 639
 640   IF_PAR_DEBUG(tables,
 641                belch("@@%%%% markLocalGAs: %d of %d GALAs marked on PE %x",
 642                      n, m, mytid));
 643 }
 644
 645 /*
 646   Traverse the GALA table: for every live remote GA check whether it has been
 647   touched during GC; if not it is not needed locally and we can free the
 648   closure (i.e. let go of its heap space and send a free message to the
 649   PE holding its GA).
 650   This routine has to be run AFTER doing the GC proper.
 651 */
 652 void
 653 rebuildGAtables(rtsBool full)
 654 {
 655   GALA *gala;
 656   GALA *next;
 657   GALA *prev;
 658   StgClosure *closure, *last, *new_closure;
 659
 660   prepareFreeMsgBuffers();
 661
 662   IF_PAR_DEBUG(tables,
 663            belch("@@%%%% rebuildGAtables: rebuilding LIVE REMOTE GAs in GALA table starting with GALA at %p\n",
 664                  liveRemoteGAs));
 665
 666   for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 667     IF_PAR_DEBUG(tables,
 668                  printGA(&(gala->ga)));
 669     next = gala->next;
 670     ASSERT(gala->ga.payload.gc.gtid != mytid); /* it's supposed to be remote */
 671
 672     closure = (StgClosure *) (gala->la);
 673     IF_PAR_DEBUG(tables,
 674              fprintf(stderr, " %p (%s) ",
 675                      (StgClosure *)closure, info_type(closure)));
 676
 677     if (!full && gala->preferred)
 678       (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 679
 680     /* Follow indirection chains to the end, just in case */
 681     // should conform with unwinding in markLocalGAs
 682     closure = UNWIND_IND(closure);
 683
 684     /*
 685        If closure has been evacuated it is live; otherwise it's dead and we
 686        can nuke the GA attached to it in the LAGA table.
 687        This approach also drops global aliases for PLCs.
 688     */
 689
 690     if (get_itbl(closure)->type == EVACUATED) {
 691       closure = ((StgEvacuated *)closure)->evacuee;
 692       IF_PAR_DEBUG(tables,
 693                    fprintf(stderr, " EVAC %p (%s)\n",
 694                            closure, info_type(closure)));
 695     } else {
 696       /* closure is not alive any more, thus remove GA and send free msg */
 697       int pe = taskIDtoPE(gala->ga.payload.gc.gtid);
 698       StgWord pga = PackGA(pe, gala->ga.payload.gc.slot);
 699
 700       /* check that the block containing this closure is not in to-space */
 701       //ASSERT(Bdescr(closure)->evacuated==0);
 702       IF_PAR_DEBUG(tables,
 703                    fprintf(stderr, " !EVAC %p (%s); sending free to PE %d\n",
 704                            closure, info_type(closure), pe));
 705
 706       (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 707       freeRemoteGA(pe, &(gala->ga));
 708       gala->next = freeGALAList;
 709       freeGALAList = gala;
 710       IF_DEBUG(sanity,
 711                gala->ga.weight = 0xdead0add;
 712                gala->la = 0xdead00aa);
 713       continue;
 714     }
 715     gala->la = closure;
 716     if (!full && gala->preferred) {
 717       GALA *q;
 718       if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
 719         if (q->preferred && gala->preferred) {
 720             q->preferred = rtsFalse;
 721             IF_PAR_DEBUG(tables,
 722                          fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
 723                            gala->la, info_type(gala->la));
 724                          printGA(&(q->ga));
 725                          fputc('\n', stderr));
 726         }
 727       } else {
 728         insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 729       }
 730     }
 731     gala->next = prev;
 732     prev = gala;
 733   }
 734   //}
 735   liveRemoteGAs = prev; /* list is reversed during marking */
 736
 737   /* If we have any remaining FREE messages to send off, do so now */
 738   sendFreeMessages();
 739
 740   IF_DEBUG(sanity,
 741            checkFreeGALAList();
 742            checkFreeIndirectionsList());
 743
 744   if (full)
 745     rebuildLAGAtable();
 746
 747   IF_PAR_DEBUG(tables,
 748            belch("@#%%%% rebuildGAtables: After ReBuilding GALA table starting with GALA at %p",
 749                  liveRemoteGAs);
 750            printLAGAtable());
 751 }
 752
 753 /*
 754   Rebuild the LA->GA table, assuming that the addresses in the GALAs are
 755   correct.
 756   A word on the lookupHashTable check in both loops:
 757   After GC we may end up with 2 preferred GAs for the same LA! For example,
 758   if we received a closure whose GA already exists on this PE we CommonUp
 759   both closures, making one an indirection to the other. Before GC everything
 760   is fine: one preferred GA refers to the IND, the other preferred GA refers
 761   to the closure it points to. After GC, however, we have short cutted the
 762   IND and suddenly we have 2 preferred GAs for the same closure. We detect
 763   this case in the loop below and deprecate one GA, so that we always just
 764   have one preferred GA per LA.
 765 */
 766
 767 //@cindex rebuildLAGAtable
 768 void
 769 rebuildLAGAtable(void)
 770 {
 771   GALA *gala;
 772   nat n=0, m=0; // debugging
 773
 774   /* The old LA->GA table is worthless */
 775   freeHashTable(LAtoGALAtable, NULL);
 776   LAtoGALAtable = allocHashTable();
 777
 778   IF_PAR_DEBUG(tables,
 779            belch("@@%%%% rebuildLAGAtable: new LAGA table at %p",
 780                  LAtoGALAtable));
 781
 782   for (gala = liveIndirections; gala != NULL; gala = gala->next) {
 783     n++;
 784     if (gala->preferred) {
 785       GALA *q;
 786       if (q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la)) {
 787         if (q->preferred && gala->preferred) {
 788           /* this deprecates q (see also GALAdeprecate) */
 789           q->preferred = rtsFalse;
 790           (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *)q);
 791           IF_PAR_DEBUG(tables,
 792                        fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
 793                                gala->la, info_type(gala->la));
 794                        printGA(&(q->ga));
 795                        fputc('\n', stderr));
 796         }
 797       }
 798       insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 799     }
 800   }
 801
 802   for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
 803     m++;
 804     if (gala->preferred) {
 805       GALA *q;
 806       if (q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la)) {
 807         if (q->preferred && gala->preferred) {
 808           /* this deprecates q (see also GALAdeprecate) */
 809           q->preferred = rtsFalse;
 810           (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *)q);
 811           IF_PAR_DEBUG(tables,
 812                        fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
 813                                gala->la, info_type(gala->la));
 814                        printGA(&(q->ga));
 815                        fputc('\n', stderr));
 816         }
 817       }
 818       insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
 819     }
 820   }
 821
 822   IF_PAR_DEBUG(tables,
 823            belch("@@%%%% rebuildLAGAtable: inserted %d entries from liveIndirections and %d entries from liveRemoteGAs",
 824                  n,m));
 825 }
 826
 827 //@node Debugging routines, Index, GC functions for GALA tables, Global Address Manipulation
 828 //@subsection Debugging routines
 829
 830 //@cindex printGA
 831 void
 832 printGA (globalAddr *ga)
 833 {
 834   fprintf(stderr, "((%x, %d, %x))",
 835           ga->payload.gc.gtid,
 836           ga->payload.gc.slot,
 837           ga->weight);
 838 }
 839
 840 //@cindex printGALA
 841 void
 842 printGALA (GALA *gala)
 843 {
 844   printGA(&(gala->ga));
 845   fprintf(stderr, " -> %p (%s)", (StgPtr)gala->la, info_type(gala->la));
 846   fprintf(stderr, " %s", (gala->preferred) ? "PREF" : "____");
 847 }
 848
 849 /*
 850   Printing the LA->GA table.
 851 */
 852
 853 //@cindex printLiveIndTable
 854 void
 855 printLiveIndTable(void)
 856 {
 857   GALA *gala, *q;
 858   nat n=0; // debugging
 859
 860   belch("@@%%%%:: logical LiveIndTable (%p) (liveIndirections=%p):",
 861         LAtoGALAtable, liveIndirections);
 862
 863   for (gala = liveIndirections; gala != NULL; gala = gala->next) {
 864     n++;
 865     printGALA(gala);
 866     /* check whether this gala->la is hashed into the LAGA table */
 867     q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
 868     fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ?  "====" : "####");
 869     //ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
 870   }
 871   belch("@@%%%%:: %d live indirections",
 872         n);
 873 }
 874
 875 void
 876 printRemoteGATable(void)
 877 {
 878   GALA *gala, *q;
 879   nat m=0; // debugging
 880
 881   belch("@@%%%%:: logical RemoteGATable (%p) (liveRemoteGAs=%p):",
 882         LAtoGALAtable, liveRemoteGAs);
 883
 884   for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
 885     m++;
 886     printGALA(gala);
 887     /* check whether this gala->la is hashed into the LAGA table */
 888     q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
 889     fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ? "====" : "####");
 890     // ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
 891   }
 892   belch("@@%%%%:: %d remote GAs",
 893         m);
 894 }
 895
 896 //@cindex printLAGAtable
 897 void
 898 printLAGAtable(void)
 899 {
 900   belch("@@%%: LAGAtable (%p) with liveIndirections=%p, liveRemoteGAs=%p:",
 901         LAtoGALAtable, liveIndirections, liveRemoteGAs);
 902
 903   printLiveIndTable();
 904   printRemoteGATable();
 905 }
 906
 907 /*
 908   Check whether a GA is already in a list.
 909 */
 910 rtsBool
 911 isOnLiveIndTable(globalAddr *ga)
 912 {
 913   GALA *gala;
 914
 915   for (gala = liveIndirections; gala != NULL; gala = gala->next)
 916     if (gala->ga.weight==ga->weight &&
 917         gala->ga.payload.gc.slot==ga->payload.gc.slot &&
 918         gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
 919       return rtsTrue;
 920
 921   return rtsFalse;
 922 }
 923
 924 rtsBool
 925 isOnRemoteGATable(globalAddr *ga)
 926 {
 927   GALA *gala;
 928
 929   for (gala = liveRemoteGAs; gala != NULL; gala = gala->next)
 930     if (gala->ga.weight==ga->weight &&
 931         gala->ga.payload.gc.slot==ga->payload.gc.slot &&
 932         gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
 933       return rtsTrue;
 934
 935   return rtsFalse;
 936 }
 937
 938 /*
 939    Sanity check for free lists.
 940 */
 941 void
 942 checkFreeGALAList(void) {
 943   GALA *gl;
 944
 945   for (gl=freeGALAList; gl != NULL; gl=gl->next) {
 946     ASSERT(gl->ga.weight==0xdead0add);
 947     ASSERT(gl->la==0xdead00aa);
 948   }
 949 }
 950
 951 void
 952 checkFreeIndirectionsList(void) {
 953   GALA *gl;
 954
 955   for (gl=freeIndirections; gl != NULL; gl=gl->next) {
 956     ASSERT(gl->ga.weight==0xdead0add);
 957     ASSERT(gl->la==0xdead00aa);
 958   }
 959 }
 960 #endif /* PAR -- whole file */
 961
 962 //@node Index,  , Debugging routines, Global Address Manipulation
 963 //@subsection Index
 964
 965 //@index
 966 //* DebugPrintLAGAtable::  @cindex\s-+DebugPrintLAGAtable
 967 //* GALAlookup::  @cindex\s-+GALAlookup
 968 //* LAGAlookup::  @cindex\s-+LAGAlookup
 969 //* LAtoGALAtable::  @cindex\s-+LAtoGALAtable
 970 //* PackGA::  @cindex\s-+PackGA
 971 //* addWeight::  @cindex\s-+addWeight
 972 //* allocGALA::  @cindex\s-+allocGALA
 973 //* allocIndirection::  @cindex\s-+allocIndirection
 974 //* freeIndirections::  @cindex\s-+freeIndirections
 975 //* initGAtables::  @cindex\s-+initGAtables
 976 //* liveIndirections::  @cindex\s-+liveIndirections
 977 //* liveRemoteGAs::  @cindex\s-+liveRemoteGAs
 978 //* makeGlobal::  @cindex\s-+makeGlobal
 979 //* markLocalGAs::  @cindex\s-+markLocalGAs
 980 //* nextIndirection::  @cindex\s-+nextIndirection
 981 //* pGAtoGALAtable::  @cindex\s-+pGAtoGALAtable
 982 //* printGA::  @cindex\s-+printGA
 983 //* printGALA::  @cindex\s-+printGALA
 984 //* rebuildLAGAtable::  @cindex\s-+rebuildLAGAtable
 985 //* registerTask::  @cindex\s-+registerTask
 986 //* setRemoteGA::  @cindex\s-+setRemoteGA
 987 //* splitWeight::  @cindex\s-+splitWeight
 988 //* taskIDtoPE::  @cindex\s-+taskIDtoPE
 989 //* taskIDtoPEtable::  @cindex\s-+taskIDtoPEtable
 990 //* thisPE::  @cindex\s-+thisPE
 991 //@end index