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