[project @ 1996-07-19 18:36:04 by partain]

[ghc-hetmet.git] / ghc / runtime / storage / SMcompacting.lc

diff --git a/ghc/runtime/storage/SMcompacting.lc b/ghc/runtime/storage/SMcompacting.lc
index 60942d3..bf78189 100644 (file)
--- a/ghc/runtime/storage/SMcompacting.lc
+++ b/ghc/runtime/storage/SMcompacting.lc
@@ -52,8 +52,97 @@ I_ rootno;
 \end{code}
 
 \begin{code}
+#if defined(GRAN)
+void
+LinkEvents(STG_NO_ARGS)
+{
+  eventq event = EventHd;
+
+# if defined(GRAN) && defined(GRAN_CHECK)
+  if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+    fprintf(RTSflags.GcFlags.statsFile,"Linking Events ...\n");
+#endif
+
+  DEBUG_STRING("Linking Events:");
+  while(event != NULL)
+    {
+      if(EVENT_TYPE(event) == RESUMETHREAD || 
+         EVENT_TYPE(event) == MOVETHREAD || 
+         EVENT_TYPE(event) == CONTINUETHREAD || 
+         EVENT_TYPE(event) == STARTTHREAD )
+
+        { LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) ); }
+
+      else if(EVENT_TYPE(event) == MOVESPARK)
+
+       { LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(EVENT_SPARK(event))) ); }
+
+      else if (EVENT_TYPE(event) == FETCHNODE ||
+               EVENT_TYPE(event) == FETCHREPLY )
+        {
+         LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
+
+         /* In the case of packet fetching, EVENT_NODE(event) points to */
+         /* the packet (currently, malloced). The packet is just a list of */
+         /* closure addresses, with the length of the list at index 1 (the */
+         /* structure of the packet is defined in Pack.lc). */
+         if ( RTSflags.GranFlags.DoGUMMFetching && 
+              (EVENT_TYPE(event)==FETCHREPLY)) {
+           P_ buffer = (P_) EVENT_NODE(event);
+           int size = (int) buffer[PACK_SIZE_LOCN], i;
+
+           for (i = PACK_HDR_SIZE; i <= size-1; i++) {
+             LINK_LOCATION_TO_CLOSURE( (buffer+i) );
+           }
+         } else 
+           { LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) ); } 
+        } 
+      else if (EVENT_TYPE(event) == GLOBALBLOCK)
+       {
+         LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
+         LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) );
+       }
+      else if (EVENT_TYPE(event) == UNBLOCKTHREAD) 
+       {
+         LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
+       }
+      event = EVENT_NEXT(event);
+    }
+}
+#endif  /* GRAN */
+\end{code}
+
+\begin{code}
+
+#if defined(CONCURRENT) 
+# if defined(GRAN)
+void
+LinkSparks(STG_NO_ARGS)
+{
+  sparkq spark;
+  PROC proc;
+  I_ pool, total_sparks=0;
+
+# if defined(GRAN) && defined(GRAN_CHECK)
+  if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+    fprintf(RTSflags.GcFlags.statsFile,"Linking Sparks ...\n");
+#endif
+
+  DEBUG_STRING("Linking Sparks:");
+  for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
+    for(pool = 0; pool < SPARK_POOLS; ++pool) {
+      for(spark = PendingSparksHd[proc][pool]; 
+         spark != NULL; 
+         spark = SPARK_NEXT(spark))
+        {
+         LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(spark)));
+        } /* forall spark ... */
+      }  /* forall pool ... */
+   }    /*forall proc .. */
+}
+
+# else /* ! GRAN */
 
-#ifdef CONCURRENT
 void
 LinkSparks(STG_NO_ARGS)
 {
@@ -68,7 +157,8 @@ LinkSparks(STG_NO_ARGS)
        }
     }
 }
-#endif
+#endif   /* GRAN */
+#endif   /* CONCURRENT */
 
 \end{code}
 
@@ -77,9 +167,7 @@ LinkSparks(STG_NO_ARGS)
 #ifdef PAR
 
 void
-LinkLiveGAs(base, bits)
-P_ base;
-BitWord *bits;
+LinkLiveGAs(P_ base, BitWord *bits)
 {
     GALA *gala;
     GALA *next;
@@ -97,7 +185,7 @@ BitWord *bits;
            prev = gala;
        } else {
            /* Since we have all of the weight, this GA is no longer needed */
-           W_ pga = PACK_GA(thisPE, gala->ga.loc.gc.slot);
+           W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 
 #ifdef FREE_DEBUG
            fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
@@ -124,8 +212,7 @@ BitWord *bits;
        bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
        if (!(bits[bit_index] & bit)) {
            int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
-           W_ pga = PACK_GA(pe, gala->ga.loc.gc.slot);
-           int i;
+           W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 
            (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
            freeRemoteGA(pe, &(gala->ga));
@@ -143,7 +230,7 @@ BitWord *bits;
     sendFreeMessages();
 }
 
-#else
+#endif
 
 \end{code}
 
@@ -151,6 +238,7 @@ Note: no \tr{Link[AB]Stack} for ``parallel'' systems, because they
 don't have a single main stack.
 
 \begin{code}
+#if !defined(PAR) /* && !defined(GRAN) */  /* HWL */
 
 void
 LinkAStack(stackA, botA)
@@ -172,7 +260,8 @@ PP_ botA;
 ToDo (Patrick?): Dont explicitly mark & compact unmarked Bstack frames
 
 \begin{code}   
-#if ! defined(PAR)
+#if !defined(PAR) /* && !defined(CONCURRENT) */ /* HWL */
+
 void
 LinkBStack(stackB, botB)
 P_ stackB;
@@ -182,14 +271,12 @@ P_ botB;                  /* stackB points to topmost update frame */
 
     DEBUG_STRING("Linking B Stack:");
     for (updateFramePtr = stackB;
-      SUBTRACT_B_STK(updateFramePtr, botB) > 0;
-      /* re-initialiser given explicitly */ ) {
+        SUBTRACT_B_STK(updateFramePtr, botB) > 0;
+        updateFramePtr = GRAB_SuB(updateFramePtr)) {
 
        P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
 
        LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
-
-       updateFramePtr = GRAB_SuB(updateFramePtr);
     }
 }
 #endif /* not PAR */
@@ -197,8 +284,7 @@ P_ botB;                    /* stackB points to topmost update frame */
 
 \begin{code}
 I_
-CountCAFs(CAFlist)
-P_ CAFlist;
+CountCAFs(P_ CAFlist)
 {
     I_ caf_no = 0;
 
@@ -211,8 +297,7 @@ P_ CAFlist;
 
 \begin{code}
 void
-LinkCAFs(CAFlist)
-P_ CAFlist;
+LinkCAFs(P_ CAFlist)
 {
     DEBUG_STRING("Linking CAF Ptr Locations:");
     while(CAFlist != NULL) {
@@ -222,13 +307,5 @@ P_ CAFlist;
     }
 }
 
-\end{code}
-
-\begin{code}
-
-#ifdef PAR
-
-#endif /* PAR */
-
 #endif /* defined(_INFO_COMPACTING) */
 \end{code}