+ heapsize = packBuffer->unpacked_size;
+ bufptr = packBuffer->buffer;
+
+ /* allocate heap */
+ if (heapsize > 0) {
+ graph = (StgClosure *)allocate(heapsize);
+ ASSERT(graph != NULL);
+ // parallel global statistics: increase amount of global data
+ if (RtsFlags.ParFlags.ParStats.Global &&
+ RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
+ globalParStats.tot_global += heapsize;
+ }
+ }
+
+ /* iterate over the buffer contents and unpack all closures */
+ parent = (StgClosure *)NULL;
+ do {
+ /* check that we aren't at the end of the buffer, yet */
+ IF_DEBUG(sanity, ASSERT(*bufptr != END_OF_BUFFER_MARKER));
+
+ /* This is where we will ultimately save the closure's address */
+ slotptr = bufptr;
+
+ /* fill in gaS from buffer; gaS may receive GA, PLC- or offset-marker */
+ bufptr = UnpackGA(/*in*/bufptr, /*out*/&gaS);
+
+ /* this allocates heap space, updates LAGA tables etc */
+ closure = UnpackClosure (/*in/out*/&bufptr, /*in/out*/&graph, /*in*/&gaS);
+ unpacked_closures++; // stats only; doesn't count FMs in PAP!!!
+ unpacked_thunks += (closure_THUNK(closure)) ? 1 : 0; // stats only
+
+ /*
+ * Set parent pointer to point to chosen closure. If we're at the top of
+ * the graph (our parent is NULL), then we want to arrange to return the
+ * chosen closure to our caller (possibly in place of the allocated graph
+ * root.)
+ */
+ if (parent == NULL)
+ graphroot = closure;
+ else
+ ((StgPtr)parent)[_HS + pvhs + pptr] = (StgWord) closure;
+
+ /* Save closure pointer for resolving offsets */
+ *slotptr = (StgWord*) closure;
+
+ /* Locate next parent pointer */
+ LocateNextParent(&parent, &pptr, &pptrs, &size);
+
+ IF_DEBUG(sanity,
+ gaS.weight = 0xdeadffff;
+ gaS.payload.gc.gtid = 0xdead;
+ gaS.payload.gc.slot = 0xdeadbeef;);
+ } while (parent != NULL);
+
+ IF_PAR_DEBUG(resume,
+ GraphFingerPrint(graphroot, graphFingerPrint);
+ ASSERT(strlen(graphFingerPrint)<=MAX_FINGER_PRINT_LEN);
+ belch(">>> Fingerprint of graph rooted at %p (after unpacking <<%d>>:\n {%s}",
+ graphroot, packBuffer->id, graphFingerPrint));
+
+ /* we unpacked exactly as many words as there are in the buffer */
+ ASSERT(bufsize == (nat) (bufptr-(packBuffer->buffer)));
+ /* we filled no more heap closure than we allocated at the beginning;
+ ideally this should be a ==;
+ NB: test is only valid if we unpacked anything at all (graphroot might
+ end up to be a PLC!), therfore the strange test for HEAP_ALLOCED
+ */
+
+ /*
+ {
+ StgInfoTable *info = get_itbl(graphroot);
+ ASSERT(!HEAP_ALLOCED(graphroot) || heapsize >= (nat) (graph-graphroot) ||
+ // ToDo: check whether CAFs are really a special case here!!
+ info->type==CAF_BLACKHOLE || info->type==FETCH_ME || info->type==FETCH_ME_BQ);
+ }
+ */
+
+ /* check for magic end-of-buffer word */
+ IF_DEBUG(sanity, ASSERT(*bufptr == END_OF_BUFFER_MARKER));
+
+ *gamap = PendingGABuffer;
+ *nGAs = (gaga - PendingGABuffer) / 2;
+
+ IF_PAR_DEBUG(tables,
+ belch("** LAGA table after unpacking closure %p:",
+ graphroot);
+ printLAGAtable());
+
+ /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
+ ASSERT(graphroot!=NULL);
+
+ IF_DEBUG(sanity,
+ {
+ StgPtr p;
+
+ /* check the unpacked graph */
+ //checkHeapChunk(graphroot,graph-sizeof(StgWord));
+
+ // if we do sanity checks, then wipe the pack buffer after unpacking
+ for (p=(StgPtr)packBuffer->buffer; p<(StgPtr)(packBuffer->buffer)+(packBuffer->size); )
+ *p++ = 0xdeadbeef;
+ });
+
+ /* reset the global variable */
+ globalUnpackBuffer = (rtsPackBuffer*)NULL;
+
+#if defined(PAR_TICKY) // HWL HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACK
+ PAR_TICKY_UNPACK_GRAPH_END(unpacked_closures, unpacked_thunks);
+#endif
+
+ return (graphroot);
+}
+
+//@cindex UnpackGA
+static StgWord **
+UnpackGA(StgWord **bufptr, globalAddr *ga)
+{
+ /* First, unpack the next GA or PLC */
+ ga->weight = (rtsWeight) *bufptr++;
+
+ if (ga->weight == 2) { // unglobalised closure to follow
+ // nothing to do; closure starts at *bufptr
+ } else if (ga->weight > 0) { // fill in GA
+ ga->payload.gc.gtid = (GlobalTaskId) *bufptr++;
+ ga->payload.gc.slot = (int) *bufptr++;
+ } else {
+ ga->payload.plc = (StgPtr) *bufptr++;
+ }
+ return bufptr;
+}
+
+//@cindex UnpackPLC
+static StgClosure *
+UnpackPLC(globalAddr *ga)
+{
+ /* No more to unpack; just set closure to local address */
+ IF_PAR_DEBUG(pack,
+ belch("*<^^ Unpacked PLC at %x", ga->payload.plc));
+ return (StgClosure*)ga->payload.plc;
+}
+
+//@cindex UnpackOffset
+static StgClosure *
+UnpackOffset(globalAddr *ga)
+{
+ /* globalUnpackBuffer is a global var init in UnpackGraph */
+ ASSERT(globalUnpackBuffer!=(rtsPackBuffer*)NULL);
+ /* No more to unpack; just set closure to cached address */
+ IF_PAR_DEBUG(pack,
+ belch("*<__ Unpacked indirection to %p (was OFFSET %d)",
+ (StgClosure *)((globalUnpackBuffer->buffer)[ga->payload.gc.slot]),
+ ga->payload.gc.slot));
+ return (StgClosure *)(globalUnpackBuffer->buffer)[ga->payload.gc.slot];
+}
+
+/*
+ Input: *bufptrP, *graphP ... ptrs to the pack buffer and into the heap.
+
+ *bufptrP points to something that should be unpacked as a FETCH_ME:
+ |
+ v
+ +-------------------------------
+ | GA | FH of FM
+ +-------------------------------
+
+ The first 3 words starting at *bufptrP are the GA address; the next
+ word is the generic FM info ptr followed by the remaining FH (if any)
+ The result after unpacking will be a FETCH_ME closure, pointed to by
+ *graphP at the start of the fct;
+ |
+ v
+ +------------------------+
+ | FH of FM | ptr to a GA |
+ +------------------------+
+
+ The ptr field points into the RemoteGA table, which holds the actual GA.
+ *bufptrP has been updated to point to the next word in the buffer.
+ *graphP has been updated to point to the first free word at the end.
+*/
+
+static StgClosure*
+UnpackFetchMe (StgWord ***bufptrP, StgClosure **graphP) {
+ StgClosure *closure, *foo;
+ globalAddr gaS;
+
+ /* This fct relies on size of FM < size of FM in pack buffer */
+ ASSERT(sizeofW(StgFetchMe)<=PACK_FETCHME_SIZE);
+
+ /* fill in gaS from buffer */
+ *bufptrP = UnpackGA(*bufptrP, &gaS);
+ /* might be an offset to a closure in the pack buffer */
+ if (isOffset(&gaS)) {
+ belch("*< UnpackFetchMe: found OFFSET to %d when unpacking FM at buffer loc %p",
+ gaS.payload.gc.slot, *bufptrP);
+
+ closure = UnpackOffset(&gaS);
+ /* return address of previously unpacked closure; leaves *graphP unchanged */
+ return closure;
+ }
+
+ /* we have a proper GA at hand */
+ ASSERT(LOOKS_LIKE_GA(&gaS));
+
+ IF_DEBUG(sanity,
+ if (isFixed(&gaS))
+ barf("*< UnpackFetchMe: found PLC where FM was expected %p (%s)",
+ *bufptrP, info_type((StgClosure*)*bufptrP)));
+
+ IF_PAR_DEBUG(pack,
+ belch("*<_- Unpacked @ %p a FETCH_ME to GA ",
+ *graphP);
+ printGA(&gaS);
+ fputc('\n', stderr));
+
+ /* the next thing must be the IP to a FETCH_ME closure */
+ ASSERT(get_itbl((StgClosure *)*bufptrP)->type == FETCH_ME);
+
+ closure = *graphP;
+ /* fill in the closure from the buffer */
+ FillInClosure(bufptrP, closure);
+
+ /* the newly built closure is a FETCH_ME */
+ ASSERT(get_itbl(closure)->type == FETCH_ME);
+
+ /* common up with other graph if necessary
+ this also assigns the contents of gaS to the ga field of the FM closure */
+ foo = SetGAandCommonUp(&gaS, closure, rtsTrue);
+
+ ASSERT(foo!=closure || LOOKS_LIKE_GA(((StgFetchMe*)closure)->ga));
+
+ IF_PAR_DEBUG(pack,
+ if (foo==closure) { // only if not commoned up
+ belch("*<_- current FM @ %p next FM @ %p; unpacked FM @ %p is ",
+ *graphP, *graphP+sizeofW(StgFetchMe), closure);
+ printClosure(closure);
+ });
+ *graphP += sizeofW(StgFetchMe);
+ return foo;
+}
+
+/*
+ Unpack an array of words.
+ Could use generic unpack most of the time, but cleaner to separate it.
+ ToDo: implement packing of MUT_ARRAYs
+*/
+
+//@cindex UnackArray
+static void
+UnpackArray(StgWord ***bufptrP, StgClosure *graph)
+{
+ StgInfoTable *info;
+ StgWord **bufptr=*bufptrP;
+ nat size, ptrs, nonptrs, vhs, i, n;
+ char str[80];
+
+ /* yes, I know I am paranoid; but who's asking !? */
+ IF_DEBUG(sanity,
+ info = get_closure_info((StgClosure*)bufptr,
+ &size, &ptrs, &nonptrs, &vhs, str);
+ ASSERT(info->type == ARR_WORDS || info->type == MUT_ARR_PTRS ||
+ info->type == MUT_ARR_PTRS_FROZEN || info->type == MUT_VAR));
+
+ n = ((StgArrWords *)bufptr)->words;
+ // this includes the header!: arr_words_sizeW(stgCast(StgArrWords*,q));
+
+ IF_PAR_DEBUG(pack,
+ if (n<100)
+ belch("*<== unpacking an array of %d words %p (%s) (size=%d) |%s|\n",
+ n, (StgClosure*)bufptr, info_type((StgClosure*)bufptr),
+ arr_words_sizeW((StgArrWords *)bufptr),
+ /* print array (string?) */
+ ((StgArrWords *)graph)->payload);
+ else
+ belch("*<== unpacking an array of %d words %p (%s) (size=%d)\n",
+ n, (StgClosure*)bufptr, info_type((StgClosure*)bufptr),
+ arr_words_sizeW((StgArrWords *)bufptr)));
+
+ /* Unpack the header (2 words: info ptr and the number of words to follow) */
+ ((StgArrWords *)graph)->header.info = (StgInfoTable*)*bufptr++; // assumes _HS==1; yuck!
+ ((StgArrWords *)graph)->words = (StgWord)*bufptr++;
+
+ /* unpack the payload of the closure (all non-ptrs) */
+ for (i=0; i<n; i++)
+ ((StgArrWords *)graph)->payload[i] = (StgWord)*bufptr++;
+
+ ASSERT(bufptr==*bufptrP+arr_words_sizeW((StgArrWords *)*bufptrP));
+ *bufptrP = bufptr;
+}
+
+/*
+ Unpack a PAP in the buffer into a heap closure.
+ For each FETCHME we find in the packed PAP we have to unpack a separate
+ FETCHME closure and insert a pointer to this closure into the PAP.
+ We unpack all FETCHMEs into an area after the PAP proper (the `FM area').
+ Note that the size of a FETCHME in the buffer is exactly the same as
+ the size of an unpacked FETCHME plus 1 word for the pointer to it.
+ Therefore, we just allocate packed_size words in the heap for the unpacking.
+ After this routine the heap starting from *graph looks like this:
+
+ graph
+ |
+ v PAP closure | FM area |
+ +------------------------------------------------------------+
+ | PAP header | n_args | fun | payload ... | FM_1 | FM_2 .... |
+ +------------------------------------------------------------+
+
+ where payload contains pointers to each of the unpacked FM_1, FM_2 ...
+ The size of the PAP closure plus all FMs is _HS+2+packed_size.
+*/