[project @ 1996-07-25 20:43:49 by partain]

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

diff --git a/ghc/runtime/storage/SMmarking.lc b/ghc/runtime/storage/SMmarking.lc
index ae92832..7297222 100644 (file)
--- a/ghc/runtime/storage/SMmarking.lc
+++ b/ghc/runtime/storage/SMmarking.lc
@@ -36,6 +36,13 @@ EXTFUN(_PRMarking_MarkNextSpark);
 EXTDATA(_PRMarking_MarkNextSpark_closure);
 #endif
 
+#if defined(GRAN)
+EXTFUN(_PRMarking_MarkNextEvent);
+EXTDATA(_PRMarking_MarkNextEvent_closure);
+EXTFUN(_PRMarking_MarkNextClosureInFetchBuffer);
+EXTDATA(_PRMarking_MarkNextClosureInFetchBuffer_closure);
+#endif
+
 #ifdef PAR
 EXTFUN(_PRMarking_MarkNextGA);
 EXTDATA(_PRMarking_MarkNextGA_closure);
@@ -47,6 +54,9 @@ EXTDATA(_PRMarking_MarkNextBStack_closure);
 #endif /* not parallel */
 
 P_ sm_roots_end;
+#if defined(GRAN)
+P_ ret_MRoot, ret_Mark;
+#endif
 
 I_
 markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
@@ -59,6 +69,12 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
 #ifdef CONCURRENT
     int pool;
 #endif
+#if defined(GRAN)
+    PROC proc;
+    eventq event;
+    sparkq spark;
+    rtsBool found = rtsFalse;
+#endif
 
     BitArray = bit_array;
     HeapBase = base;
@@ -74,7 +90,84 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
        miniInterpret((StgFunPtr)_startMarkWorld);
     }
 
-#ifdef CONCURRENT
+#if defined(GRAN)
+    DEBUG_STRING("Marking Events (GRAN): ");
+    MRoot = (P_) EventHd;
+    found = rtsFalse;
+    do { 
+      if (MRoot != NULL) {
+       /* inlined version of MarkNextEvent */
+       switch (EVENT_TYPE( ((eventq) MRoot) )) {
+         case CONTINUETHREAD:
+         case STARTTHREAD:
+         case RESUMETHREAD:
+         case MOVETHREAD:
+            EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+            Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+         case MOVESPARK:
+            EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+            Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+         case FETCHNODE:
+            EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+            Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+         case FETCHREPLY:
+            EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+            Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+          case GLOBALBLOCK:
+            EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
+            Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+         case UNBLOCKTHREAD:
+            Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
+            MStack = (P_) _PRMarking_MarkNextEvent_closure;
+            miniInterpret((StgFunPtr)_startMarkWorld);
+            found = rtsTrue;
+            break;
+         case FINDWORK:
+            MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
+            found = rtsFalse;
+            break;
+         default:
+            fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n",
+                             EVENT_TYPE( ((eventq) MRoot) ), MRoot);
+              EXIT(EXIT_FAILURE);
+        }
+      }
+    } while (!found && MRoot != NULL);
+
+    DEBUG_STRING("Marking Sparks (GRAN):");
+    for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
+      for(pool = 0; pool < SPARK_POOLS; pool++) {
+        MRoot = (P_) PendingSparksHd[proc][pool];
+         if (MRoot != NULL) {
+          Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
+          MStack = (P_) _PRMarking_MarkNextSpark_closure;
+          miniInterpret((StgFunPtr)_startMarkWorld);
+        }
+      }    /* forall pool ..   */
+    }     /* forall proc ...  */
+#endif /* GRAN */
+
+#if defined(CONCURRENT) && !defined(GRAN)
     for(pool = 0; pool < SPARK_POOLS; pool++) {
        if (PendingSparksHd[pool] < PendingSparksTl[pool]) {
            sm_roots_end = (P_) PendingSparksTl[pool];
@@ -99,7 +192,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array)
        miniInterpret((StgFunPtr) _startMarkWorld);
     }
 #else
-    /* Note: no *external* stacks in parallel world */
+    /* Note: no *external* stacks in parallel/concurrent world */
+
     DEBUG_STRING("Marking A Stack:");
     if (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) >= 0) {
        MRoot = (P_) MAIN_SpA;