rts/parallel/Global.c

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