ghc/rts/parallel/Global.c

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