Fix building RTS with gcc 2.*; declare all variables at the top of a block

[ghc-hetmet.git] / rts / sm / GC.c

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index c181940..e4b5098 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -1,9 +1,14 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2003
+ * (c) The GHC Team 1998-2006
  *
  * Generational garbage collector
  *
+ * Documentation on the architecture of the Garbage Collector can be
+ * found in the online commentary:
+ * 
+ *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
@@ -12,8 +17,6 @@
 #include "RtsUtils.h"
 #include "Apply.h"
 #include "OSThreads.h"
-#include "Storage.h"
-#include "Stable.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "Stats.h"
@@ -28,15 +31,6 @@
 #include "ParTicky.h"          // ToDo: move into Rts.h
 #include "RtsSignals.h"
 #include "STM.h"
-#if defined(GRAN) || defined(PAR)
-# include "GranSimRts.h"
-# include "ParallelRts.h"
-# include "FetchMe.h"
-# if defined(DEBUG)
-#  include "Printer.h"
-#  include "ParallelDebug.h"
-# endif
-#endif
 #include "HsFFI.h"
 #include "Linker.h"
 #if defined(RTS_GTK_FRONTPANEL)
@@ -205,17 +199,19 @@ GarbageCollect ( rtsBool force_major_gc )
   lnat oldgen_saved_blocks = 0;
   nat g, s, i;
 
-  ACQUIRE_SM_LOCK;
-
 #ifdef PROFILING
   CostCentreStack *prev_CCS;
 #endif
 
+  ACQUIRE_SM_LOCK;
+
   debugTrace(DEBUG_gc, "starting GC");
 
 #if defined(RTS_USER_SIGNALS)
-  // block signals
-  blockUserSignals();
+  if (RtsFlags.MiscFlags.install_signal_handlers) {
+    // block signals
+    blockUserSignals();
+  }
 #endif
 
   // tell the STM to discard any cached closures its hoping to re-use
@@ -235,9 +231,6 @@ GarbageCollect ( rtsBool force_major_gc )
   mutlist_OTHERS = 0;
 #endif
 
-  // Init stats and print par specific (timing) info 
-  PAR_TICKY_PAR_START();
-
   // attribute any costs to CCS_GC 
 #ifdef PROFILING
   prev_CCS = CCCS;
@@ -273,9 +266,6 @@ GarbageCollect ( rtsBool force_major_gc )
 #endif
 
   // check stack sanity *before* GC (ToDo: check all threads) 
-#if defined(GRAN)
-  // ToDo!: check sanity  IF_DEBUG(sanity, checkTSOsSanity());
-#endif
   IF_DEBUG(sanity, checkFreeListSanity());
 
   /* Initialise the static object lists
@@ -466,7 +456,6 @@ GarbageCollect ( rtsBool force_major_gc )
     }
 
     for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
-      IF_PAR_DEBUG(verbose, printMutableList(&generations[g]));
       scavenge_mutable_list(&generations[g]);
       evac_gen = g;
       for (st = generations[g].n_steps-1; st >= 0; st--) {
@@ -485,21 +474,6 @@ GarbageCollect ( rtsBool force_major_gc )
   evac_gen = 0;
   GetRoots(mark_root);
 
-#if defined(PAR)
-  /* And don't forget to mark the TSO if we got here direct from
-   * Haskell! */
-  /* Not needed in a seq version?
-  if (CurrentTSO) {
-    CurrentTSO = (StgTSO *)MarkRoot((StgClosure *)CurrentTSO);
-  }
-  */
-
-  // Mark the entries in the GALA table of the parallel system 
-  markLocalGAs(major_gc);
-  // Mark all entries on the list of pending fetches 
-  markPendingFetches(major_gc);
-#endif
-
   /* Mark the weak pointer list, and prepare to detect dead weak
    * pointers.
    */
@@ -510,10 +484,6 @@ GarbageCollect ( rtsBool force_major_gc )
    */
   markStablePtrTable(mark_root);
 
-  /* Mark the root pointer table.
-   */
-  markRootPtrTable(mark_root);
-
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.
@@ -614,12 +584,6 @@ GarbageCollect ( rtsBool force_major_gc )
       }
   }
 
-#if defined(PAR)
-  // Reconstruct the Global Address tables used in GUM 
-  rebuildGAtables(major_gc);
-  IF_DEBUG(sanity, checkLAGAtable(rtsTrue/*check closures, too*/));
-#endif
-
   // Now see which stable names are still alive.
   gcStablePtrTable();
 
@@ -687,7 +651,7 @@ GarbageCollect ( rtsBool force_major_gc )
        if (g <= N) {
          copied -= stp->hp_bd->start + BLOCK_SIZE_W -
            stp->hp_bd->free;
-         scavd_copied -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
+         scavd_copied -= stp->scavd_hpLim - stp->scavd_hp;
        }
       }
 
@@ -1052,13 +1016,13 @@ GarbageCollect ( rtsBool force_major_gc )
   stat_endGC(allocated, live, copied, scavd_copied, N);
 
 #if defined(RTS_USER_SIGNALS)
-  // unblock signals again
-  unblockUserSignals();
+  if (RtsFlags.MiscFlags.install_signal_handlers) {
+    // unblock signals again
+    unblockUserSignals();
+  }
 #endif
 
   RELEASE_SM_LOCK;
-
-  //PAR_TICKY_TP();
 }
 
 /* -----------------------------------------------------------------------------
@@ -1067,6 +1031,7 @@ GarbageCollect ( rtsBool force_major_gc )
    closure if it is alive, or NULL otherwise.
 
    NOTE: Use it before compaction only!
+         It untags and (if needed) retags pointers to closures.
    -------------------------------------------------------------------------- */
 
 
@@ -1075,8 +1040,12 @@ isAlive(StgClosure *p)
 {
   const StgInfoTable *info;
   bdescr *bd;
+  StgWord tag;
 
   while (1) {
+    /* The tag and the pointer are split, to be merged later when needed. */
+    tag = GET_CLOSURE_TAG(p);
+    p = UNTAG_CLOSURE(p);
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl(p);
@@ -1088,18 +1057,18 @@ isAlive(StgClosure *p)
     // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
     //
     if (!HEAP_ALLOCED(p)) {
-       return p;
+       return TAG_CLOSURE(tag,p);
     }
 
     // ignore closures in generations that we're not collecting. 
     bd = Bdescr((P_)p);
     if (bd->gen_no > N) {
-       return p;
+       return TAG_CLOSURE(tag,p);
     }
 
     // if it's a pointer into to-space, then we're done
     if (bd->flags & BF_EVACUATED) {
-       return p;
+       return TAG_CLOSURE(tag,p);
     }
 
     // large objects use the evacuated flag
@@ -1109,7 +1078,7 @@ isAlive(StgClosure *p)
 
     // check the mark bit for compacted steps
     if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
-       return p;
+       return TAG_CLOSURE(tag,p);
     }
 
     switch (info->type) {