%
% (c) Parade/AQUA Projects, Glasgow University, 1995
%     Kevin Hammond, February 15th. 1995
%
%     This is for GUM and GrAnSim.
%
%************************************************************************
%*                                                                      *
\section[Unpack.lc]{Unpacking closures which have been exported to remote processors}
%*									*
%************************************************************************

This module defines routines for unpacking closures in the parallel runtime
system (GUM).

In the case of GrAnSim, this module defines routines for *simulating* the 
unpacking of closures as it is done in the parallel runtime system.

\begin{code}
#include "rtsdefs.h"

#if defined(PAR) 

EXTDATA_RO(FetchMe_info);
\end{code}

Local Definitions.

\begin{code}
static globalAddr *PendingGABuffer;  /* HWL; init in main; */

void
InitPendingGABuffer(size)
W_ size; 
{
  PendingGABuffer
    = (globalAddr *) stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr), "InitPendingGABuffer");
}
\end{code}

@CommonUp@ commons up two closures which we have discovered to be
variants of the same object.  One is made an indirection to the other.

\begin{code}
void
CommonUp(P_ src, P_ dst)
{
    P_ bqe;

    ASSERT(src != dst);
    switch (INFO_TYPE(INFO_PTR(src))) {
    case INFO_SPEC_RBH_TYPE:
	bqe = (P_) SPEC_RBH_BQ(src);
	break;
    case INFO_GEN_RBH_TYPE:
	bqe = (P_) GEN_RBH_BQ(src);
	break;
    case INFO_FETCHME_TYPE:
	bqe = Prelude_Z91Z93_closure;
	break;
    case INFO_FMBQ_TYPE:
	bqe = (P_) FMBQ_ENTRIES(src);
	break;
    default:
	/* Don't common up anything else */
	return;

    }
    /* Note that UPD_IND does *not* awaken the bq */
    UPD_IND(src, dst);
    ASSERT(!IS_BIG_MOTHER(INFO_PTR(dst)));
    if (IS_MUTABLE(INFO_PTR(bqe)))
	AwakenBlockingQueue(bqe);
}

\end{code}

@UnpackGraph@ unpacks the graph contained in a message buffer.  It
returns a pointer to the new graph.  The @gamap@ parameter is set to
point to an array of (oldGA,newGA) pairs which were created as a
result of unpacking the buffer; @nGAs@ is set to the number of GA
pairs which were created.

The format of graph in the pack buffer is as defined in @Pack.lc@.

\begin{code}
P_
UnpackGraph(buffer, gamap, nGAs)
P_ buffer;
globalAddr **gamap;
W_ *nGAs;
{
    W_ size, ptrs, nonptrs, vhs;

    P_ bufptr = buffer + PACK_HDR_SIZE;

    P_ slotptr;

    globalAddr ga;
    P_ closure, existing;
    P_ ip, oldip;

    W_ bufsize;
    P_ graphroot, graph, parent;
    W_ pptr = 0, pptrs = 0, pvhs;
    char str[80];

    int i;
    globalAddr *gaga;

    InitPackBuffer(); /* in case it isn't already init'd */

    gaga = PendingGABuffer;

    InitClosureQueue();

    /* Unpack the header */
    bufsize = buffer[0];

    /* allocate heap */
    if (bufsize > 0) {
	graph = AllocateHeap(bufsize);
        ASSERT(graph != NULL);
    }

    parent = NULL;

    do {
	/* This is where we will ultimately save the closure's address */
	slotptr = bufptr;

	/* First, unpack the next GA or PLC */
	ga.weight = *bufptr++;

	if (ga.weight > 0) {
	    ga.loc.gc.gtid = *bufptr++;
	    ga.loc.gc.slot = *bufptr++;
	} else
	    ga.loc.plc = (P_) *bufptr++;

	/* Now unpack the closure body, if there is one */
	if (isFixed(&ga)) {
	  /* No more to unpack; just set closure to local address */
#ifdef PACK_DEBUG
	  fprintf(stderr, "Unpacked PLC at %x \n", ga.loc.plc); 
#endif
	  closure = ga.loc.plc;
	} else if (isOffset(&ga)) {
	    /* No more to unpack; just set closure to cached address */
	    ASSERT(parent != NULL);
	    closure = (P_) buffer[ga.loc.gc.slot];
	} else {

	    /* Now we have to build something. */

	  ASSERT(bufsize > 0);

	  /*
	   * Close your eyes.  You don't want to see where we're looking. You
	   * can't get closure info until you've unpacked the variable header,
	   * but you don't know how big it is until you've got closure info.
	   * So...we trust that the closure in the buffer is organized the
	   * same way as they will be in the heap...at least up through the
	   * end of the variable header.
	   */
	  ip = get_closure_info(bufptr, &size, &ptrs, &nonptrs, &vhs, str);
	  
	  /* Fill in the fixed header */
	  for (i = 0; i < FIXED_HS; i++)
	    graph[i] = *bufptr++;

	  if (INFO_TYPE(ip) == INFO_FETCHME_TYPE)
	    size = ptrs = nonptrs = vhs = 0;

	  /* Fill in the packed variable header */
	  for (i = 0; i < vhs; i++)
	    graph[FIXED_HS + i] = *bufptr++;

	  /* Pointers will be filled in later */

	  /* Fill in the packed non-pointers */
	  for (i = 0; i < nonptrs; i++)
	    graph[FIXED_HS + i + vhs + ptrs] = *bufptr++;
                
	  /* Indirections are never packed */
	  ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);

	  /* Add to queue for processing */
	  QueueClosure(graph);
	
	  /*
	   * Common up the new closure with any existing closure having the same
	   * GA
	   */

	  if ((existing = GALAlookup(&ga)) == NULL) {
	    globalAddr *newGA;
	    /* Just keep the new object */
#ifdef PACK_DEBUG
	    fprintf(stderr, "Unpacking new (%x, %d, %x)\n", 
		    ga.loc.gc.gtid, ga.loc.gc.slot, ga.weight);
#endif
	    closure = graph;
	    newGA = setRemoteGA(graph, &ga, rtsTrue);
	    if (INFO_TYPE(ip) == INFO_FETCHME_TYPE)
	      FETCHME_GA(closure) = newGA;
	  } else {
	    /* Two closures, one global name.  Someone loses */
	    oldip = (P_) INFO_PTR(existing);

	    if ((INFO_TYPE(oldip) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(oldip)) &&
		INFO_TYPE(ip) != INFO_FETCHME_TYPE) {

	      /* What we had wasn't worth keeping */
	      closure = graph;
	      CommonUp(existing, graph);
	    } else {

	      /*
	       * Either we already had something worthwhile by this name or
	       * the new thing is just another FetchMe.  However, the thing we
	       * just unpacked has to be left as-is, or the child unpacking
	       * code will fail.  Remember that the way pointer words are
	       * filled in depends on the info pointers of the parents being
	       * the same as when they were packed.
	       */
#ifdef PACK_DEBUG
	      fprintf(stderr, "Unpacking old (%x, %d, %x), keeping %#lx\n", 
		      ga.loc.gc.gtid, ga.loc.gc.slot, ga.weight, existing);
#endif
	      closure = existing;
	    }
	    /* Pool the total weight in the stored ga */
	    (void) addWeight(&ga);
	  }

	  /* Sort out the global address mapping */
	  if ((IS_THUNK(ip) && IS_UPDATABLE(ip)) || 
	      (IS_MUTABLE(ip) && INFO_TYPE(ip) != INFO_FETCHME_TYPE)) {
	    /* Make up new GAs for single-copy closures */
	    globalAddr *newGA = MakeGlobal(closure, rtsTrue);

	    ASSERT(closure == graph);

	    /* Create an old GA to new GA mapping */
	    *gaga++ = ga;
	    splitWeight(gaga, newGA);
	    ASSERT(gaga->weight == 1L << (BITS_IN(unsigned) - 1));
	    gaga++;
	  }
	  graph += FIXED_HS + (size < MIN_UPD_SIZE ? MIN_UPD_SIZE : size);
	}

	/*
	 * 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
	    parent[FIXED_HS + pvhs + pptr] = (W_) closure;

	/* Save closure pointer for resolving offsets */
	*slotptr = (W_) closure;

	/* Locate next parent pointer */
	pptr++;
	while (pptr + 1 > pptrs) {
	    parent = DeQueueClosure();

	    if (parent == NULL)
		break;
	    else {
		(void) get_closure_info(parent, &size, &pptrs, &nonptrs,
					&pvhs, str);
		pptr = 0;
	    }
	}
    } while (parent != NULL);

    ASSERT(bufsize == 0 || graph - 1 <= SAVE_Hp);

    *gamap = PendingGABuffer;
    *nGAs = (gaga - PendingGABuffer) / 2;

    /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
    return (graphroot);
}
#endif  /* PAR */
\end{code}

For GrAnSim:
In general no actual unpacking should be necessary. We just have to walk
over the graph and set the bitmasks appropriately. -- HWL

\begin{code}
#if defined(GRAN)
/* This code fakes the unpacking of a somewhat virtual buffer */
P_
UnpackGraph(buffer)
P_ buffer;
{
    W_ size, ptrs, nonptrs, vhs;
    P_ bufptr, closurestart;
    P_ slotptr;
    P_ closure, existing;
    P_ ip, oldip;
    W_ bufsize, unpackedsize;
    P_ graphroot, graph, parent;
    W_ pptr = 0, pptrs = 0, pvhs;
    char str[80];
    int i;
    P_ tso;

    bufptr = buffer + PACK_HDR_SIZE;
    graphroot = *bufptr;

#  if defined(GRAN_CHECK) && defined(GRAN)  /* Just for testing */
    if (buffer[PACK_FLAG_LOCN] != MAGIC_PACK_FLAG) {
      fprintf(stderr,"Qagh: no magic flag at start of packet @ 0x%lx\n", 
                      buffer);
      EXIT(EXIT_FAILURE);
   }
#  endif

    tso = buffer[PACK_TSO_LOCN];

    /* Unpack the header */
    unpackedsize = buffer[PACK_UNPACKED_SIZE_LOCN];
    bufsize = buffer[PACK_SIZE_LOCN];

#  if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
    if ( RTSflags.GranFlags.debug & 0x100 ) 
	fprintf(stderr,"\nUnpacking buffer @ 0x%x (root @ 0x%x, PE %d,size
= %d), demanded by TSO 0x%x (%d)(PE %d)\n",
		buffer,graphroot,where_is(graphroot), bufsize, tso, TSO_ID(tso), where_is(tso));
#  endif

    do {
        closurestart = bufptr; 
	closure = *bufptr++;       /* that's all we need for GrAnSim -- HWL */

	/* Actually only ip is needed; rest is useful for TESTING -- HWL */
	ip = get_closure_info(closure, 
			      &size, &ptrs, &nonptrs, &vhs, str);

#  if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
        if ( RTSflags.GranFlags.debug & 0x100 )
	    fprintf(stderr,"(0x%x): Bitmask changed [%s]: 0x%x ",
		    closure, (IS_NF(INFO_PTR(closure)) ? "NF" : "__"),
	            PROCS(closure));
#  endif

        if ( (INFO_TYPE(ip) == INFO_SPEC_RBH_TYPE) ||
	     (INFO_TYPE(ip) == INFO_GEN_RBH_TYPE) ) {
	    PROCS(closure) = PE_NUMBER(CurrentProc);          /* Move node */
#  if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
	    if ( RTSflags.GranFlags.debug & 0x100 ) {
		fprintf(stderr," ---> 0x%x\n", PROCS(closure));
		fprintf(stderr,"< Converting RBH @ 0x%x into an updatable
closure again\n",
		      closure);
	    }
#  endif
	    convertFromRBH(closure);  /* In GUM that's done by convertToFetchMe */
	} else if (IS_BLACK_HOLE(ip)) {
	    PROCS(closure) |= PE_NUMBER(CurrentProc);         /* Copy node */
        } else if ( (PROCS(closure) & PE_NUMBER(CurrentProc)) == 0 ) {
	  if (IS_NF(ip))                            /* Old: || IS_BQ(node) */
	    PROCS(closure) |= PE_NUMBER(CurrentProc);         /* Copy node */
	  else
	    PROCS(closure) = PE_NUMBER(CurrentProc);          /* Move node */
	}

#  if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
        if ( RTSflags.GranFlags.debug & 0x100 )
	  fprintf(stderr," ---> 0x%x\n",   PROCS(closure));
#  endif

    } while (bufptr<(buffer+bufsize)) ;   /*  (parent != NULL);  */

    /* In GrAnSim we allocate pack buffers dynamically! -- HWL */
    free(buffer);

    return (graphroot);
}
#endif  /* GRAN */
\end{code}