projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1997-10-05 20:32:22 by sof]
[ghc-hetmet.git] / ghc / runtime / c-as-asm / HpOverflow.lc
diff --git a/ghc/runtime/c-as-asm/HpOverflow.lc b/ghc/runtime/c-as-asm/HpOverflow.lc
index ed76a80..d7e5e1f 100644 (file)
--- a/ghc/runtime/c-as-asm/HpOverflow.lc
+++ b/ghc/runtime/c-as-asm/HpOverflow.lc
@@ -102,7 +102,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
        }
 # endif
 # if defined(GRAN)
-       ReSchedule(SAME_THREAD); /* ToDo: Check HWL */
+       ReSchedule(SAME_THREAD);
 # else
        ReSchedule(1);
 # endif
@@ -159,6 +159,11 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
                 displacement); */
     }
 
+    /* Add the stable pointer table to the roots list */
+#ifndef PAR
+   StorageMgrInfo.roots[num_ptr_roots++] = StorageMgrInfo.StablePointerTable;
+#endif
+
     ASSERT(num_ptr_roots <= SM_MAXROOTS);
     StorageMgrInfo.rootno = num_ptr_roots;
 
@@ -180,7 +185,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
       GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection);
 
       if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) {
-       OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/
+       OutOfHeapHook(reqsize * sizeof(W_), RTSflags.GcFlags.heapSize * sizeof(W_)); /*msg*/
        shutdownHaskell();
        EXIT(EXIT_FAILURE);
 
@@ -213,6 +218,11 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection)
     /* root restoring ------------------------------- */
     /* must do all the restoring exactly backwards to the storing! */
 
+    /* remove the stable pointer table first */
+#ifndef PAR
+    StorageMgrInfo.StablePointerTable = StorageMgrInfo.roots[--num_ptr_roots];
+#endif
+
     /* now the general regs, in *backwards* order */
 
 # define __DEROOT_PTR_REG(cond,n) /* n == 1 <=> R1 */  \
@@ -280,6 +290,11 @@ PerformReschedule(liveness, always_reenter_node)
 {
     rtsBool need_to_reschedule;
 
+#if 0 && defined(DEBUG)
+    fprintf(stderr,"PerfReS:liveness=0x%lx,reenter=%lx,,context_switch=%ld\n",
+       liveness, always_reenter_node, context_switch);
+#endif
+
     /* Reset the global NeedToReSchedule -- 
        this is used only to communicate the fact that we should schedule
        a new thread rather than the existing one following a fetch.
@@ -400,11 +415,11 @@ PruneSparks(STG_NO_ARGS)
 
              /* HACK! This clause should actually never happen  HWL */
              if ( (SPARK_NODE(spark) == NULL) || 
-                  (SPARK_NODE(spark) == Prelude_Z91Z93_closure) ) {
+                  (SPARK_NODE(spark) == PrelBase_Z91Z93_closure) ) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
                  if ( RTSflags.GcFlags.giveStats && 
                       (RTSflags.GranFlags.debug & 0x40) ) 
-                   fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Prelude_Z91Z93_closure\n", spark);
+                   fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or PrelBase_Z91Z93_closure\n", spark);
 #  endif
                  /* prune it below */
                }
@@ -424,7 +439,7 @@ PruneSparks(STG_NO_ARGS)
          if(RTSflags.GranFlags.granSimStats_Sparks)
              /* DumpRawGranEvent(CURRENT_PROC,SP_PRUNED,(W_) spark); */
              DumpRawGranEvent(CurrentProc,0,SP_PRUNED,
-                              Prelude_Z91Z93_closure,SPARK_NODE(spark),0);
+                              PrelBase_Z91Z93_closure,SPARK_NODE(spark),0);
 
          DisposeSpark(spark);
          prunedSparks++;
@@ -544,11 +559,11 @@ PruneSparks(STG_NO_ARGS)
                
        /* HACK! This clause should actually never happen  HWL */
        if ( (SPARK_NODE(spark) == NULL) || 
-            (SPARK_NODE(spark) == Prelude_Z91Z93_closure) ) {
+            (SPARK_NODE(spark) == PrelBase_Z91Z93_closure) ) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
            if ( RTSflags.GcFlags.giveStats && 
                 (RTSflags.GranFlags.debug & 0x40) ) 
-               fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Prelude_Z91Z93_closure\n", spark);
+               fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or PrelBase_Z91Z93_closure\n", spark);
 #  endif
            /* prune it below */
        } else if (SHOULD_SPARK(SPARK_NODE(spark))) {
@@ -583,9 +598,9 @@ PruneSparks(STG_NO_ARGS)
         /* By now we know that the spark has to be pruned */
        if(RTSflags.GranFlags.granSimStats_Sparks)
            DumpRawGranEvent(CurrentProc,0,SP_PRUNED,
-                            Prelude_Z91Z93_closure,SPARK_NODE(spark),0);
+                            PrelBase_Z91Z93_closure,SPARK_NODE(spark),0);
            
-       SPARK_NODE(spark) = Prelude_Z91Z93_closure;
+       SPARK_NODE(spark) = PrelBase_Z91Z93_closure;
        curr_spark[proc][pool] = SPARK_NEXT(spark);
        prunedSparks[proc][pool]++;
        DisposeSpark(spark);
@@ -604,9 +619,9 @@ PruneSparks(STG_NO_ARGS)
        if ( spark != NULL ) {
          if(RTSflags.GranFlags.granSimStats_Sparks)
            DumpRawGranEvent(CurrentProc,0,SP_PRUNED,
-                            Prelude_Z91Z93_closure,SPARK_NODE(spark),0);
+                            PrelBase_Z91Z93_closure,SPARK_NODE(spark),0);
            
-         SPARK_NODE(spark) = Prelude_Z91Z93_closure;
+         SPARK_NODE(spark) = PrelBase_Z91Z93_closure;
          curr_spark[proc][pool] = SPARK_NEXT(spark);
        
          prunedSparks[proc][pool]++;
@@ -671,7 +686,7 @@ PruneSparks(STG_NO_ARGS)
            /* ToDo: Fix log entries for pruned sparks in GUM */
                if(RTSflags.GranFlags.granSimStats_Sparks)
                  /* DumpSparkGranEvent(SP_PRUNED, threadId++);*/
-                 DumpGranEvent(SP_PRUNED,Prelude_Z91Z93_closure);
+                 DumpGranEvent(SP_PRUNED,PrelBase_Z91Z93_closure);
                                          ^^^^^^^^^^^ should be a TSO
 #  endif
            }
@@ -719,41 +734,48 @@ rtsBool do_full_collection;
        Will & Phil 95/10
     */
 
-    for(stack = AvailableStack; stack != Prelude_Z91Z93_closure; stack = next) {
+    for(stack = AvailableStack; stack != PrelBase_Z91Z93_closure; stack = next) {
        next = STKO_LINK(stack);
        FREEZE_MUT_HDR(stack, ImMutArrayOfPtrs_info);
        MUTUPLE_CLOSURE_SIZE(stack) = MUTUPLE_VHS;
     }
 
-    for(tso = AvailableTSO; tso != Prelude_Z91Z93_closure; tso = next) {
+    for(tso = AvailableTSO; tso != PrelBase_Z91Z93_closure; tso = next) {
        next = TSO_LINK(tso);
        FREEZE_MUT_HDR(tso, ImMutArrayOfPtrs_info);
        MUTUPLE_CLOSURE_SIZE(tso) = MUTUPLE_VHS;
     }
 
-    AvailableStack = AvailableTSO = Prelude_Z91Z93_closure;
+    AvailableStack = AvailableTSO = PrelBase_Z91Z93_closure;
 
     PruneSparks();
 
 # if defined(GRAN)
+    traverse_eventq_for_gc();         /* tidy up eventq for GC */
+
     /* Store head and tail of runnable lists as roots for GC */
-    for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
+    if (RTSflags.GranFlags.Light) {
+         StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd[0];
+         StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[0];
+    } else { 
+      for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
-       if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
-           fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
-                   num_ptr_roots,proc,RunnableThreadsHd[proc]);
+         if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+             fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n",
+                     num_ptr_roots,proc,RunnableThreadsHd[proc]);
 #  endif       
-
-       StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd[proc];
-
+  
+         StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsHd[proc];
+  
 #  if defined(GRAN_CHECK) && defined(GRAN)
-       if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
-           fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
-                   num_ptr_roots,proc,RunnableThreadsTl[proc]);
+         if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+             fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n",
+                     num_ptr_roots,proc,RunnableThreadsTl[proc]);
 #  endif       
-       StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
-
-    }  /* forall proc ... */
+         StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc];
+  
+      }  /* forall proc ... */
+    }  /* RTSflags.GranFlags.Light */
 
     /* This is now done as part of collectHeap (see ../storage dir) */
     /* num_ptr_roots = SaveSparkRoots(num_ptr_roots); */
@@ -797,7 +819,7 @@ rtsBool do_full_collection;
     /* ====> The REAL THING happens here */    
     if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) { 
 
-       OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/
+       OutOfHeapHook(reqsize * sizeof(W_), RTSflags.GcFlags.heapSize * sizeof(W_)); /*msg*/
 
 # if defined(TICKY_TICKY)
        if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
@@ -842,27 +864,30 @@ rtsBool do_full_collection;
 
     /* NB: PROC is unsigned datatype i.e. (PROC)-1 > 0 !  */
 
-    for(proc = RTSflags.GranFlags.proc - 1; 
-       (proc >= 0) && (proc < RTSflags.GranFlags.proc) ; 
-       --proc) {
+    if (RTSflags.GranFlags.Light) {
+         RunnableThreadsTl[0] = StorageMgrInfo.roots[--num_ptr_roots] ;
+         RunnableThreadsHd[0] = StorageMgrInfo.roots[--num_ptr_roots] ;
+    } else { 
+      for(proc = RTSflags.GranFlags.proc - 1; 
+         (proc >= 0) && (proc < RTSflags.GranFlags.proc) ; 
+         --proc) {
 #  if defined(GRAN_CHECK) && defined(GRAN)
-       if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
-           fprintf(RTSflags.GcFlags.statsFile,
-                   "Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
-                   num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
+         if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+             fprintf(RTSflags.GcFlags.statsFile,
+                     "Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n",
+                     num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
 #  endif
-
-       RunnableThreadsTl[proc] = StorageMgrInfo.roots[--num_ptr_roots];
-
+         RunnableThreadsTl[proc] = StorageMgrInfo.roots[--num_ptr_roots];
+  
 #  if defined(GRAN_CHECK) && defined(GRAN)
-       if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
-           fprintf(RTSflags.GcFlags.statsFile,
-                   "Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
-                   num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
+         if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
+             fprintf(RTSflags.GcFlags.statsFile,
+                     "Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n",
+                     num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]);
 #  endif
-
-       RunnableThreadsHd[proc] = StorageMgrInfo.roots[--num_ptr_roots];
-    }  /* forall proc ... */
+         RunnableThreadsHd[proc] = StorageMgrInfo.roots[--num_ptr_roots];
+      }  /* forall proc ... */
+    }  /* RTSflags.GranFlags.Light */
 
 # endif /* GRAN */
 
@@ -909,12 +934,3 @@ BlackHoleUpdateStack(STG_NO_ARGS)
 }
 #endif /* !CONCURRENT */
 \end{code}
-
-
-\begin{code}
-#if 0 /* defined(CONCURRENT) && !defined(GRAN) */
-void
-PerformReschedule(W_ liveness, W_ always_reenter_node)
-{ }
-#endif
-\end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)