Document UniqSupply
[ghc-hetmet.git] / 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