X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fgum%2FUnpack.lc;h=2df6741c57c6ee1864374229fd4b08b72f614e1e;hb=967cc47f37cb93a5e2b6df7822c9a646f0428247;hp=52b4cad8d21c52d66c023c881fa92133b558b051;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git

diff --git a/ghc/runtime/gum/Unpack.lc b/ghc/runtime/gum/Unpack.lc
index 52b4cad..2df6741 100644
--- a/ghc/runtime/gum/Unpack.lc
+++ b/ghc/runtime/gum/Unpack.lc
@@ -2,7 +2,7 @@
 % (c) Parade/AQUA Projects, Glasgow University, 1995
 %     Kevin Hammond, February 15th. 1995
 %
-%     This is for GUM only.
+%     This is for GUM and GrAnSim.
 %
 %************************************************************************
 %*                                                                      *
@@ -13,10 +13,14 @@
 This module defines routines for unpacking closures in the parallel runtime
 system (GUM).
 
-\begin{code}
-#ifdef PAR /* whole file */
+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}
 
@@ -52,7 +56,7 @@ CommonUp(P_ src, P_ dst)
 	bqe = (P_) GEN_RBH_BQ(src);
 	break;
     case INFO_FETCHME_TYPE:
-	bqe = Nil_closure;
+	bqe = PrelBase_Z91Z93_closure;
 	break;
     case INFO_FMBQ_TYPE:
 	bqe = (P_) FMBQ_ENTRIES(src);
@@ -99,6 +103,7 @@ W_ *nGAs;
     W_ bufsize;
     P_ graphroot, graph, parent;
     W_ pptr = 0, pptrs = 0, pvhs;
+    char str[80];
 
     int i;
     globalAddr *gaga;
@@ -158,7 +163,7 @@ W_ *nGAs;
 	   * 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);
+	  ip = get_closure_info(bufptr, &size, &ptrs, &nonptrs, &vhs, str);
 	  
 	  /* Fill in the fixed header */
 	  for (i = 0; i < FIXED_HS; i++)
@@ -268,7 +273,8 @@ W_ *nGAs;
 	    if (parent == NULL)
 		break;
 	    else {
-		(void) get_closure_info(parent, &size, &pptrs, &nonptrs, &pvhs);
+		(void) get_closure_info(parent, &size, &pptrs, &nonptrs,
+					&pvhs, str);
 		pptr = 0;
 	    }
 	}
@@ -282,8 +288,104 @@ W_ *nGAs;
     /* 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}
-#endif /* PAR -- whole file */
+#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}
+