ghc/rts/parallel/0Unpack.c

   1 /*
   2   Time-stamp: <Wed Jan 12 2000 13:29:08 Stardate: [-30]4193.85 hwloidl>
   3
   4   Unpacking closures which have been exported to remote processors
   5
   6   This module defines routines for unpacking closures in the parallel
   7   runtime system (GUM).
   8
   9   In the case of GrAnSim, this module defines routines for *simulating* the
  10   unpacking of closures as it is done in the parallel runtime system.
  11 */
  12
  13 /*
  14    Code in this file has been merged with Pack.c
  15 */
  16
  17 #if 0
  18
  19 //@node Unpacking closures, , ,
  20 //@section Unpacking closures
  21
  22 //@menu
  23 //* Includes::
  24 //* Prototypes::
  25 //* GUM code::
  26 //* GranSim Code::
  27 //* Index::
  28 //@end menu
  29 //*/
  30
  31 //@node Includes, Prototypes, Unpacking closures, Unpacking closures
  32 //@subsection Includes
  33
  34 #include "Rts.h"
  35 #include "RtsFlags.h"
  36 #include "GranSimRts.h"
  37 #include "ParallelRts.h"
  38 #include "ParallelDebug.h"
  39 #include "FetchMe.h"
  40 #include "Storage.h"
  41
  42 //@node Prototypes, GUM code, Includes, Unpacking closures
  43 //@subsection Prototypes
  44
  45 void     InitPacking(void);
  46 # if defined(PAR)
  47 void            InitPackBuffer(void);
  48 # endif
  49 /* Interface for ADT of closure queues */
  50 void              AllocClosureQueue(nat size);
  51 void              InitClosureQueue(void);
  52 rtsBool           QueueEmpty(void);
  53 void              QueueClosure(StgClosure *closure);
  54 StgClosure *DeQueueClosure(void);
  55
  56 StgPtr AllocateHeap(nat size);
  57
  58 //@node GUM code, GranSim Code, Prototypes, Unpacking closures
  59 //@subsection GUM code
  60
  61 #if defined(PAR)
  62
  63 //@node Local Definitions,  , GUM code, GUM code
  64 //@subsubsection Local Definitions
  65
  66 //@cindex PendingGABuffer
  67 static globalAddr *PendingGABuffer;
  68 /* is initialised in main; */
  69
  70 //@cindex InitPendingGABuffer
  71 void
  72 InitPendingGABuffer(size)
  73 nat size;
  74 {
  75   PendingGABuffer = (globalAddr *)
  76                       stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr),
  77                                      "InitPendingGABuffer");
  78 }
  79
  80 /*
  81   @CommonUp@ commons up two closures which we have discovered to be
  82   variants of the same object.  One is made an indirection to the other.  */
  83
  84 //@cindex CommonUp
  85 void
  86 CommonUp(StgClosure *src, StgClosure *dst)
  87 {
  88   StgBlockingQueueElement *bqe;
  89
  90   ASSERT(src != dst);
  91   switch (get_itbl(src)->type) {
  92   case BLACKHOLE_BQ:
  93     bqe = ((StgBlockingQueue *)src)->blocking_queue;
  94     break;
  95
  96   case FETCH_ME_BQ:
  97     bqe = ((StgFetchMeBlockingQueue *)src)->blocking_queue;
  98     break;
  99
 100   case RBH:
 101     bqe = ((StgRBH *)src)->blocking_queue;
 102     break;
 103
 104   case BLACKHOLE:
 105   case FETCH_ME:
 106     bqe = END_BQ_QUEUE;
 107     break;
 108
 109   default:
 110     /* Don't common up anything else */
 111     return;
 112   }
 113   /* We do not use UPD_IND because that would awaken the bq, too */
 114   // UPD_IND(src, dst);
 115   updateWithIndirection(get_itbl(src), src, dst);
 116   //ASSERT(!IS_BIG_MOTHER(INFO_PTR(dst)));
 117   if (bqe != END_BQ_QUEUE)
 118     awaken_blocked_queue(bqe, src);
 119 }
 120
 121 /*
 122   @UnpackGraph@ unpacks the graph contained in a message buffer.  It
 123   returns a pointer to the new graph.  The @gamap@ parameter is set to
 124   point to an array of (oldGA,newGA) pairs which were created as a result
 125   of unpacking the buffer; @nGAs@ is set to the number of GA pairs which
 126   were created.
 127
 128   The format of graph in the pack buffer is as defined in @Pack.lc@.  */
 129
 130 //@cindex UnpackGraph
 131 StgClosure *
 132 UnpackGraph(packBuffer, gamap, nGAs)
 133 rtsPackBuffer *packBuffer;
 134 globalAddr **gamap;
 135 nat *nGAs;
 136 {
 137   nat size, ptrs, nonptrs, vhs;
 138   StgWord **buffer, **bufptr, **slotptr;
 139   globalAddr ga, *gaga;
 140   StgClosure *closure, *existing,
 141              *graphroot, *graph, *parent;
 142   StgInfoTable *ip, *oldip;
 143   nat bufsize, i,
 144       pptr = 0, pptrs = 0, pvhs;
 145   char str[80];
 146
 147   InitPackBuffer();                  /* in case it isn't already init'd */
 148   graphroot = (StgClosure *)NULL;
 149
 150   gaga = PendingGABuffer;
 151
 152   InitClosureQueue();
 153
 154   /* Unpack the header */
 155   bufsize = packBuffer->size;
 156   buffer = packBuffer->buffer;
 157   bufptr = buffer;
 158
 159   /* allocate heap */
 160   if (bufsize > 0) {
 161     graph = allocate(bufsize);
 162     ASSERT(graph != NULL);
 163   }
 164
 165   parent = (StgClosure *)NULL;
 166
 167   do {
 168     /* This is where we will ultimately save the closure's address */
 169     slotptr = bufptr;
 170
 171     /* First, unpack the next GA or PLC */
 172     ga.weight = (rtsWeight) *bufptr++;
 173
 174     if (ga.weight > 0) {
 175       ga.payload.gc.gtid = (GlobalTaskId) *bufptr++;
 176       ga.payload.gc.slot = (int) *bufptr++;
 177     } else
 178       ga.payload.plc = (StgPtr) *bufptr++;
 179
 180     /* Now unpack the closure body, if there is one */
 181     if (isFixed(&ga)) {
 182       /* No more to unpack; just set closure to local address */
 183       IF_PAR_DEBUG(pack,
 184                    belch("Unpacked PLC at %x", ga.payload.plc));
 185       closure = ga.payload.plc;
 186     } else if (isOffset(&ga)) {
 187       /* No more to unpack; just set closure to cached address */
 188       ASSERT(parent != (StgClosure *)NULL);
 189       closure = (StgClosure *) buffer[ga.payload.gc.slot];
 190     } else {
 191       /* Now we have to build something. */
 192
 193       ASSERT(bufsize > 0);
 194
 195       /*
 196        * Close your eyes.  You don't want to see where we're looking. You
 197        * can't get closure info until you've unpacked the variable header,
 198        * but you don't know how big it is until you've got closure info.
 199        * So...we trust that the closure in the buffer is organized the
 200        * same way as they will be in the heap...at least up through the
 201        * end of the variable header.
 202        */
 203       ip = get_closure_info(bufptr, &size, &ptrs, &nonptrs, &vhs, str);
 204
 205       /*
 206          Remember, the generic closure layout is as follows:
 207          +-------------------------------------------------+
 208          | FIXED HEADER | VARIABLE HEADER | PTRS | NON-PRS |
 209          +-------------------------------------------------+
 210       */
 211       /* Fill in the fixed header */
 212       for (i = 0; i < FIXED_HS; i++)
 213         ((StgPtr)graph)[i] = *bufptr++;
 214
 215       if (ip->type == FETCH_ME)
 216         size = ptrs = nonptrs = vhs = 0;
 217
 218       /* Fill in the packed variable header */
 219       for (i = 0; i < vhs; i++)
 220         ((StgPtr)graph)[FIXED_HS + i] = *bufptr++;
 221
 222       /* Pointers will be filled in later */
 223
 224       /* Fill in the packed non-pointers */
 225       for (i = 0; i < nonptrs; i++)
 226         ((StgPtr)graph)[FIXED_HS + i + vhs + ptrs] = *bufptr++;
 227
 228       /* Indirections are never packed */
 229       // ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
 230
 231       /* Add to queue for processing */
 232       QueueClosure(graph);
 233
 234       /*
 235        * Common up the new closure with any existing closure having the same
 236        * GA
 237        */
 238
 239       if ((existing = GALAlookup(&ga)) == NULL) {
 240         globalAddr *newGA;
 241         /* Just keep the new object */
 242         IF_PAR_DEBUG(pack,
 243                      belch("Unpacking new (%x, %d, %x)\n",
 244                            ga.payload.gc.gtid, ga.payload.gc.slot, ga.weight));
 245
 246         closure = graph;
 247         newGA = setRemoteGA(graph, &ga, rtsTrue);
 248         if (ip->type == FETCH_ME)
 249           // FETCHME_GA(closure) = newGA;
 250           ((StgFetchMe *)closure)->ga = newGA;
 251       } else {
 252         /* Two closures, one global name.  Someone loses */
 253         oldip = get_itbl(existing);
 254
 255         if ((oldip->type == FETCH_ME || IS_BLACK_HOLE(existing)) &&
 256             ip->type != FETCH_ME) {
 257
 258           /* What we had wasn't worth keeping */
 259           closure = graph;
 260           CommonUp(existing, graph);
 261         } else {
 262
 263           /*
 264            * Either we already had something worthwhile by this name or
 265            * the new thing is just another FetchMe.  However, the thing we
 266            * just unpacked has to be left as-is, or the child unpacking
 267            * code will fail.  Remember that the way pointer words are
 268            * filled in depends on the info pointers of the parents being
 269            * the same as when they were packed.
 270            */
 271           IF_PAR_DEBUG(pack,
 272                        belch("Unpacking old (%x, %d, %x), keeping %#lx",
 273                              ga.payload.gc.gtid, ga.payload.gc.slot, ga.weight,
 274                              existing));
 275
 276           closure = existing;
 277         }
 278         /* Pool the total weight in the stored ga */
 279         (void) addWeight(&ga);
 280       }
 281
 282       /* Sort out the global address mapping */
 283       if ((ip_THUNK(ip) && !ip_UNPOINTED(ip)) ||
 284           (ip_MUTABLE(ip) && ip->type != FETCH_ME)) {
 285         /* Make up new GAs for single-copy closures */
 286         globalAddr *newGA = makeGlobal(closure, rtsTrue);
 287
 288         ASSERT(closure == graph);
 289
 290         /* Create an old GA to new GA mapping */
 291         *gaga++ = ga;
 292         splitWeight(gaga, newGA);
 293         ASSERT(gaga->weight == 1L << (BITS_IN(unsigned) - 1));
 294         gaga++;
 295       }
 296       graph += FIXED_HS + (size < MIN_UPD_SIZE ? MIN_UPD_SIZE : size);
 297     }
 298
 299     /*
 300      * Set parent pointer to point to chosen closure.  If we're at the top of
 301      * the graph (our parent is NULL), then we want to arrange to return the
 302      * chosen closure to our caller (possibly in place of the allocated graph
 303      * root.)
 304      */
 305     if (parent == NULL)
 306       graphroot = closure;
 307     else
 308       ((StgPtr)parent)[FIXED_HS + pvhs + pptr] = (StgWord) closure;
 309
 310     /* Save closure pointer for resolving offsets */
 311     *slotptr = (StgWord) closure;
 312
 313     /* Locate next parent pointer */
 314     pptr++;
 315     while (pptr + 1 > pptrs) {
 316       parent = DeQueueClosure();
 317
 318       if (parent == NULL)
 319         break;
 320       else {
 321         (void) get_closure_info(parent, &size, &pptrs, &nonptrs,
 322                                         &pvhs, str);
 323         pptr = 0;
 324       }
 325     }
 326   } while (parent != NULL);
 327
 328   ASSERT(bufsize == 0 || graph - 1 <= SAVE_Hp);
 329
 330   *gamap = PendingGABuffer;
 331   *nGAs = (gaga - PendingGABuffer) / 2;
 332
 333   /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
 334   ASSERT(graphroot!=NULL);
 335   return (graphroot);
 336 }
 337 #endif  /* PAR */
 338
 339 //@node GranSim Code, Index, GUM code, Unpacking closures
 340 //@subsection GranSim Code
 341
 342 /*
 343    For GrAnSim: In general no actual unpacking should be necessary. We just
 344    have to walk over the graph and set the bitmasks appropriately. -- HWL */
 345
 346 //@node Unpacking,  , GranSim Code, GranSim Code
 347 //@subsubsection Unpacking
 348
 349 #if defined(GRAN)
 350 void
 351 CommonUp(StgClosure *src, StgClosure *dst)
 352 {
 353   barf("CommonUp: should never be entered in a GranSim setup");
 354 }
 355
 356 /* This code fakes the unpacking of a somewhat virtual buffer */
 357 StgClosure*
 358 UnpackGraph(buffer)
 359 rtsPackBuffer* buffer;
 360 {
 361   nat size, ptrs, nonptrs, vhs,
 362       bufptr = 0;
 363   StgClosure *closure, *graphroot, *graph;
 364   StgInfoTable *ip;
 365   StgWord bufsize, unpackedsize,
 366           pptr = 0, pptrs = 0, pvhs;
 367   StgTSO* tso;
 368   char str[240], str1[80];
 369   int i;
 370
 371   bufptr = 0;
 372   graphroot = buffer->buffer[0];
 373
 374   tso = buffer->tso;
 375
 376   /* Unpack the header */
 377   unpackedsize = buffer->unpacked_size;
 378   bufsize = buffer->size;
 379
 380   IF_GRAN_DEBUG(pack,
 381                 belch("<<< Unpacking <<%d>> (buffer @ %p):\n    (root @ %p, PE %d,size=%d), demanded by TSO %d (%p)[PE %d]",
 382                       buffer->id, buffer, graphroot, where_is(graphroot),
 383                       bufsize, tso->id, tso,
 384                       where_is((StgClosure *)tso)));
 385
 386   do {
 387     closure = buffer->buffer[bufptr++]; /* that's all we need for GrAnSim -- HWL */
 388
 389     /* Actually only ip is needed; rest is useful for TESTING -- HWL */
 390     ip = get_closure_info(closure,
 391                           &size, &ptrs, &nonptrs, &vhs, str);
 392
 393     IF_GRAN_DEBUG(pack,
 394                   sprintf(str, "**    (%p): Changing bitmask[%s]: 0x%x ",
 395                           closure, (closure_HNF(closure) ? "NF" : "__"),
 396                           PROCS(closure)));
 397
 398     if (ip->type == RBH) {
 399       closure->header.gran.procs = PE_NUMBER(CurrentProc);    /* Move node */
 400
 401       IF_GRAN_DEBUG(pack,
 402                     strcat(str, " (converting RBH) "));
 403
 404       convertFromRBH(closure);   /* In GUM that's done by convertToFetchMe */
 405     } else if (IS_BLACK_HOLE(closure)) {
 406       closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
 407     } else if ( closure->header.gran.procs & PE_NUMBER(CurrentProc) == 0 ) {
 408       if (closure_HNF(closure))
 409         closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
 410       else
 411         closure->header.gran.procs = PE_NUMBER(CurrentProc);  /* Move node */
 412     }
 413
 414     IF_GRAN_DEBUG(pack,
 415                   sprintf(str1, "0x%x",   PROCS(closure)); strcat(str, str1));
 416     IF_GRAN_DEBUG(pack, belch(str));
 417
 418   } while (bufptr<buffer->size) ;   /*  (parent != NULL);  */
 419
 420   /* In GrAnSim we allocate pack buffers dynamically! -- HWL */
 421   free(buffer->buffer);
 422   free(buffer);
 423
 424   IF_GRAN_DEBUG(pack,
 425                 belch("PrintGraph of %p is:", graphroot); PrintGraph(graphroot,0));
 426
 427   return (graphroot);
 428 }
 429 #endif  /* GRAN */
 430 #endif
 431
 432 //@node Index,  , GranSim Code, Unpacking closures
 433 //@subsection Index
 434
 435 //@index
 436 //* CommonUp::  @cindex\s-+CommonUp
 437 //* InitPendingGABuffer::  @cindex\s-+InitPendingGABuffer
 438 //* PendingGABuffer::  @cindex\s-+PendingGABuffer
 439 //* UnpackGraph::  @cindex\s-+UnpackGraph
 440 //@end index