ghc/runtime/gum/Unpack.lc

   1 %
   2 % (c) Parade/AQUA Projects, Glasgow University, 1995
   3 %     Kevin Hammond, February 15th. 1995
   4 %
   5 %     This is for GUM only.
   6 %
   7 %************************************************************************
   8 %*                                                                      *
   9 \section[Unpack.lc]{Unpacking closures which have been exported to remote processors}
  10 %*                                                                      *
  11 %************************************************************************
  12
  13 This module defines routines for unpacking closures in the parallel runtime
  14 system (GUM).
  15
  16 \begin{code}
  17 #ifdef PAR /* whole file */
  18
  19 #include "rtsdefs.h"
  20 EXTDATA_RO(FetchMe_info);
  21 \end{code}
  22
  23 Local Definitions.
  24
  25 \begin{code}
  26 static globalAddr *PendingGABuffer;  /* HWL; init in main; */
  27
  28 void
  29 InitPendingGABuffer(size)
  30 W_ size;
  31 {
  32   PendingGABuffer
  33     = (globalAddr *) stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr), "InitPendingGABuffer");
  34 }
  35 \end{code}
  36
  37 @CommonUp@ commons up two closures which we have discovered to be
  38 variants of the same object.  One is made an indirection to the other.
  39
  40 \begin{code}
  41 void
  42 CommonUp(P_ src, P_ dst)
  43 {
  44     P_ bqe;
  45
  46     ASSERT(src != dst);
  47     switch (INFO_TYPE(INFO_PTR(src))) {
  48     case INFO_SPEC_RBH_TYPE:
  49         bqe = (P_) SPEC_RBH_BQ(src);
  50         break;
  51     case INFO_GEN_RBH_TYPE:
  52         bqe = (P_) GEN_RBH_BQ(src);
  53         break;
  54     case INFO_FETCHME_TYPE:
  55         bqe = Nil_closure;
  56         break;
  57     case INFO_FMBQ_TYPE:
  58         bqe = (P_) FMBQ_ENTRIES(src);
  59         break;
  60     default:
  61         /* Don't common up anything else */
  62         return;
  63
  64     }
  65     /* Note that UPD_IND does *not* awaken the bq */
  66     UPD_IND(src, dst);
  67     ASSERT(!IS_BIG_MOTHER(INFO_PTR(dst)));
  68     if (IS_MUTABLE(INFO_PTR(bqe)))
  69         AwakenBlockingQueue(bqe);
  70 }
  71
  72 \end{code}
  73
  74 @UnpackGraph@ unpacks the graph contained in a message buffer.  It
  75 returns a pointer to the new graph.  The @gamap@ parameter is set to
  76 point to an array of (oldGA,newGA) pairs which were created as a
  77 result of unpacking the buffer; @nGAs@ is set to the number of GA
  78 pairs which were created.
  79
  80 The format of graph in the pack buffer is as defined in @Pack.lc@.
  81
  82 \begin{code}
  83 P_
  84 UnpackGraph(buffer, gamap, nGAs)
  85 P_ buffer;
  86 globalAddr **gamap;
  87 W_ *nGAs;
  88 {
  89     W_ size, ptrs, nonptrs, vhs;
  90
  91     P_ bufptr = buffer + PACK_HDR_SIZE;
  92
  93     P_ slotptr;
  94
  95     globalAddr ga;
  96     P_ closure, existing;
  97     P_ ip, oldip;
  98
  99     W_ bufsize;
 100     P_ graphroot, graph, parent;
 101     W_ pptr = 0, pptrs = 0, pvhs;
 102
 103     int i;
 104     globalAddr *gaga;
 105
 106     InitPackBuffer(); /* in case it isn't already init'd */
 107
 108     gaga = PendingGABuffer;
 109
 110     InitClosureQueue();
 111
 112     /* Unpack the header */
 113     bufsize = buffer[0];
 114
 115     /* allocate heap */
 116     if (bufsize > 0) {
 117         graph = AllocateHeap(bufsize);
 118         ASSERT(graph != NULL);
 119     }
 120
 121     parent = NULL;
 122
 123     do {
 124         /* This is where we will ultimately save the closure's address */
 125         slotptr = bufptr;
 126
 127         /* First, unpack the next GA or PLC */
 128         ga.weight = *bufptr++;
 129
 130         if (ga.weight > 0) {
 131             ga.loc.gc.gtid = *bufptr++;
 132             ga.loc.gc.slot = *bufptr++;
 133         } else
 134             ga.loc.plc = (P_) *bufptr++;
 135
 136         /* Now unpack the closure body, if there is one */
 137         if (isFixed(&ga)) {
 138           /* No more to unpack; just set closure to local address */
 139 #ifdef PACK_DEBUG
 140           fprintf(stderr, "Unpacked PLC at %x \n", ga.loc.plc);
 141 #endif
 142           closure = ga.loc.plc;
 143         } else if (isOffset(&ga)) {
 144             /* No more to unpack; just set closure to cached address */
 145             ASSERT(parent != NULL);
 146             closure = (P_) buffer[ga.loc.gc.slot];
 147         } else {
 148
 149             /* Now we have to build something. */
 150
 151           ASSERT(bufsize > 0);
 152
 153           /*
 154            * Close your eyes.  You don't want to see where we're looking. You
 155            * can't get closure info until you've unpacked the variable header,
 156            * but you don't know how big it is until you've got closure info.
 157            * So...we trust that the closure in the buffer is organized the
 158            * same way as they will be in the heap...at least up through the
 159            * end of the variable header.
 160            */
 161           ip = get_closure_info(bufptr, &size, &ptrs, &nonptrs, &vhs);
 162
 163           /* Fill in the fixed header */
 164           for (i = 0; i < FIXED_HS; i++)
 165             graph[i] = *bufptr++;
 166
 167           if (INFO_TYPE(ip) == INFO_FETCHME_TYPE)
 168             size = ptrs = nonptrs = vhs = 0;
 169
 170           /* Fill in the packed variable header */
 171           for (i = 0; i < vhs; i++)
 172             graph[FIXED_HS + i] = *bufptr++;
 173
 174           /* Pointers will be filled in later */
 175
 176           /* Fill in the packed non-pointers */
 177           for (i = 0; i < nonptrs; i++)
 178             graph[FIXED_HS + i + vhs + ptrs] = *bufptr++;
 179
 180           /* Indirections are never packed */
 181           ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
 182
 183           /* Add to queue for processing */
 184           QueueClosure(graph);
 185
 186           /*
 187            * Common up the new closure with any existing closure having the same
 188            * GA
 189            */
 190
 191           if ((existing = GALAlookup(&ga)) == NULL) {
 192             globalAddr *newGA;
 193             /* Just keep the new object */
 194 #ifdef PACK_DEBUG
 195             fprintf(stderr, "Unpacking new (%x, %d, %x)\n",
 196                     ga.loc.gc.gtid, ga.loc.gc.slot, ga.weight);
 197 #endif
 198             closure = graph;
 199             newGA = setRemoteGA(graph, &ga, rtsTrue);
 200             if (INFO_TYPE(ip) == INFO_FETCHME_TYPE)
 201               FETCHME_GA(closure) = newGA;
 202           } else {
 203             /* Two closures, one global name.  Someone loses */
 204             oldip = (P_) INFO_PTR(existing);
 205
 206             if ((INFO_TYPE(oldip) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(oldip)) &&
 207                 INFO_TYPE(ip) != INFO_FETCHME_TYPE) {
 208
 209               /* What we had wasn't worth keeping */
 210               closure = graph;
 211               CommonUp(existing, graph);
 212             } else {
 213
 214               /*
 215                * Either we already had something worthwhile by this name or
 216                * the new thing is just another FetchMe.  However, the thing we
 217                * just unpacked has to be left as-is, or the child unpacking
 218                * code will fail.  Remember that the way pointer words are
 219                * filled in depends on the info pointers of the parents being
 220                * the same as when they were packed.
 221                */
 222 #ifdef PACK_DEBUG
 223               fprintf(stderr, "Unpacking old (%x, %d, %x), keeping %#lx\n",
 224                       ga.loc.gc.gtid, ga.loc.gc.slot, ga.weight, existing);
 225 #endif
 226               closure = existing;
 227             }
 228             /* Pool the total weight in the stored ga */
 229             (void) addWeight(&ga);
 230           }
 231
 232           /* Sort out the global address mapping */
 233           if ((IS_THUNK(ip) && IS_UPDATABLE(ip)) ||
 234               (IS_MUTABLE(ip) && INFO_TYPE(ip) != INFO_FETCHME_TYPE)) {
 235             /* Make up new GAs for single-copy closures */
 236             globalAddr *newGA = MakeGlobal(closure, rtsTrue);
 237
 238             ASSERT(closure == graph);
 239
 240             /* Create an old GA to new GA mapping */
 241             *gaga++ = ga;
 242             splitWeight(gaga, newGA);
 243             ASSERT(gaga->weight == 1L << (BITS_IN(unsigned) - 1));
 244             gaga++;
 245           }
 246           graph += FIXED_HS + (size < MIN_UPD_SIZE ? MIN_UPD_SIZE : size);
 247         }
 248
 249         /*
 250          * Set parent pointer to point to chosen closure.  If we're at the top of
 251          * the graph (our parent is NULL), then we want to arrange to return the
 252          * chosen closure to our caller (possibly in place of the allocated graph
 253          * root.)
 254          */
 255         if (parent == NULL)
 256             graphroot = closure;
 257         else
 258             parent[FIXED_HS + pvhs + pptr] = (W_) closure;
 259
 260         /* Save closure pointer for resolving offsets */
 261         *slotptr = (W_) closure;
 262
 263         /* Locate next parent pointer */
 264         pptr++;
 265         while (pptr + 1 > pptrs) {
 266             parent = DeQueueClosure();
 267
 268             if (parent == NULL)
 269                 break;
 270             else {
 271                 (void) get_closure_info(parent, &size, &pptrs, &nonptrs, &pvhs);
 272                 pptr = 0;
 273             }
 274         }
 275     } while (parent != NULL);
 276
 277     ASSERT(bufsize == 0 || graph - 1 <= SAVE_Hp);
 278
 279     *gamap = PendingGABuffer;
 280     *nGAs = (gaga - PendingGABuffer) / 2;
 281
 282     /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
 283     return (graphroot);
 284 }
 285 \end{code}
 286
 287 \begin{code}
 288 #endif /* PAR -- whole file */
 289 \end{code}