path: root/ghc/runtime/gum/Unpack.lc

%
% (c) Parade/AQUA Projects, Glasgow University, 1995
%     Kevin Hammond, February 15th. 1995
%
%     This is for GUM only.
%
%************************************************************************
%*                                                                      *
\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).

\begin{code}
#ifdef PAR /* whole file */

#include "rtsdefs.h"
EXTDATA_RO(FetchMe_info);
\end{code}

Local Definitions.

\begin{code}
static globalAddr PendingGABuffer[(PACK_BUFFER_SIZE-PACK_HDR_SIZE)*2];
\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(src, dst)
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 = Nil_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;

    int i;

    globalAddr *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);
	  
	  /* 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);

	  /* 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);
		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);
}
\end{code}

\begin{code}
#endif /* PAR -- whole file */
\end{code}