← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to rts/parallel/0Unpack.c

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
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