X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=d0d035ccd7cfe650ee93af342a4832629733660b;hb=dbef766ce79e37a74468a07a93b15ba1f06fe8f8;hp=67d744aa93de0524834d725b22a996b734fdccd5;hpb=310e95ebc5fb9211bb512adcec19152ac5a458d4;p=ghc-hetmet.git

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 67d744a..d0d035c 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.119 2001/08/10 10:52:12 simonmar Exp $
+ * $Id: GC.c,v 1.128 2001/11/26 16:54:21 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -7,6 +7,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsFlags.h"
 #include "RtsUtils.h"
@@ -41,6 +42,9 @@
 #include "FrontPanel.h"
 #endif
 
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+
 /* STATIC OBJECT LIST.
  *
  * During GC:
@@ -141,7 +145,6 @@ static void         scavenge_large          ( step * );
 static void         scavenge_static         ( void );
 static void         scavenge_mutable_list   ( generation *g );
 static void         scavenge_mut_once_list  ( generation *g );
-static void         scavengeCAFs            ( void );
 
 #if 0 && defined(DEBUG)
 static void         gcCAFs                  ( void );
@@ -461,7 +464,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
     }
   }
 
-  scavengeCAFs();
+  /* follow roots from the CAF list (used by GHCi)
+   */
+  evac_gen = 0;
+  markCAFs(mark_root);
 
   /* follow all the roots that the application knows about.
    */
@@ -599,6 +605,13 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
   }
 
+#ifdef PROFILING
+  // We call processHeapClosureForDead() on every closure destroyed during
+  // the current garbage collection, so we invoke LdvCensusForDead().
+  if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
+    LdvCensusForDead(N);
+#endif
+
   // NO MORE EVACUATION AFTER THIS POINT!
   // Finally: compaction of the oldest generation.
   if (major_gc && oldest_gen->steps[0].is_compacted) {
@@ -740,10 +753,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
 
       // Auto-enable compaction when the residency reaches a
       // certain percentage of the maximum heap size (default: 30%).
-      if (RtsFlags.GcFlags.compact ||
-	  (max > 0 &&
-	   oldest_gen->steps[0].n_blocks > 
-	   (RtsFlags.GcFlags.compactThreshold * max) / 100)) {
+      if (RtsFlags.GcFlags.generations > 1 &&
+	  (RtsFlags.GcFlags.compact ||
+	   (max > 0 &&
+	    oldest_gen->steps[0].n_blocks > 
+	    (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
 	  oldest_gen->steps[0].is_compacted = 1;
 //	  fprintf(stderr,"compaction: on\n", live);
       } else {
@@ -756,6 +770,14 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       // different if compaction is turned on, because we don't need
       // to double the space required to collect the old generation.
       if (max != 0) {
+
+	  // this test is necessary to ensure that the calculations
+	  // below don't have any negative results - we're working
+	  // with unsigned values here.
+	  if (max < min_alloc) {
+	      heapOverflow();
+	  }
+
 	  if (oldest_gen->steps[0].is_compacted) {
 	      if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
 		  size = (max - min_alloc) / ((gens - 1) * 2 - 1);
@@ -847,8 +869,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
      */
     blocks = g0s0->n_to_blocks;
 
-    if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
-	 RtsFlags.GcFlags.maxHeapSize ) {
+    if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
+	 blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
+	   RtsFlags.GcFlags.maxHeapSize ) {
       long adjusted_blocks;  // signed on purpose 
       int pc_free; 
       
@@ -907,6 +930,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
       
       resizeNursery((nat)blocks);
+
+    } else {
+      // we might have added extra large blocks to the nursery, so
+      // resize back to minAllocAreaSize again.
+      resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
     }
   }
 
@@ -915,6 +943,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   if (major_gc) { gcCAFs(); }
 #endif
   
+#ifdef PROFILING
+  // resetStaticObjectForRetainerProfiling() must be called before
+  // zeroing below.
+  resetStaticObjectForRetainerProfiling();
+#endif
+
   // zero the scavenged static object list 
   if (major_gc) {
     zero_static_object_list(scavenged_static_objects);
@@ -945,7 +979,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
 
   // restore enclosing cost centre 
 #ifdef PROFILING
-  heapCensus();
   CCCS = prev_CCS;
 #endif
 
@@ -1253,6 +1286,10 @@ static __inline__ StgClosure *
 copy(StgClosure *src, nat size, step *stp)
 {
   P_ to, from, dest;
+#ifdef PROFILING
+  // @LDV profiling
+  nat size_org = size;
+#endif
 
   TICK_GC_WORDS_COPIED(size);
   /* Find out where we're going, using the handy "to" pointer in 
@@ -1282,6 +1319,11 @@ copy(StgClosure *src, nat size, step *stp)
   dest = stp->hp;
   stp->hp = to;
   upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+  // We store the size of the just evacuated object in the LDV word so that
+  // the profiler can guess the position of the next object later.
+  SET_EVACUAEE_FOR_LDV(src, size_org);
+#endif
   return (StgClosure *)dest;
 }
 
@@ -1291,10 +1333,14 @@ copy(StgClosure *src, nat size, step *stp)
  */
 
 
-static __inline__ StgClosure *
+static StgClosure *
 copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
 {
   P_ dest, to, from;
+#ifdef PROFILING
+  // @LDV profiling
+  nat size_to_copy_org = size_to_copy;
+#endif
 
   TICK_GC_WORDS_COPIED(size_to_copy);
   if (stp->gen_no < evac_gen) {
@@ -1316,6 +1362,16 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
   dest = stp->hp;
   stp->hp += size_to_reserve;
   upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+  // We store the size of the just evacuated object in the LDV word so that
+  // the profiler can guess the position of the next object later.
+  // size_to_copy_org is wrong because the closure already occupies size_to_reserve
+  // words.
+  SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
+  // fill the slop
+  if (size_to_reserve - size_to_copy_org > 0)
+    FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org)); 
+#endif
   return (StgClosure *)dest;
 }
 
@@ -1454,6 +1510,9 @@ loop:
   if (HEAP_ALLOCED(q)) {
     bd = Bdescr((P_)q);
 
+    // not a group head: find the group head
+    if (bd->blocks == 0) { bd = bd->link; }
+
     if (bd->gen_no > N) {
 	/* Can't evacuate this object, because it's in a generation
 	 * older than the ones we're collecting.  Let's hope that it's
@@ -1592,6 +1651,7 @@ loop:
       case CONSTR_1_1:
       case CONSTR_0_2:
       case CONSTR_STATIC:
+      case CONSTR_NOCAF_STATIC:
 	{ 
 	  StgWord offset = info->layout.selector_offset;
 
@@ -2140,9 +2200,23 @@ scavenge(step *stp)
     }
 
     case IND_PERM:
-	if (stp->gen_no != 0) {
-	    SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-	}
+      if (stp->gen->no != 0) {
+#ifdef PROFILING
+        // @LDV profiling
+        // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an 
+        // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
+        LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
+#endif        
+        // 
+        // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+        //
+	SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
+#ifdef PROFILING
+        // @LDV profiling
+        // We pretend that p has just been created.
+        LDV_recordCreate((StgClosure *)p);
+#endif
+      }
 	// fall through 
     case IND_OLDGEN_PERM:
 	((StgIndOldGen *)p)->indirectee = 
@@ -3461,15 +3535,14 @@ revertCAFs( void )
 }
 
 void
-scavengeCAFs( void )
+markCAFs( evac_fn evac )
 {
     StgIndStatic *c;
 
-    evac_gen = 0;
     for (c = (StgIndStatic *)caf_list; c != NULL; 
 	 c = (StgIndStatic *)c->static_link) 
     {
-	c->indirectee = evacuate(c->indirectee);
+	evac(&c->indirectee);
     }
 }
 
@@ -3569,7 +3642,17 @@ threadLazyBlackHole(StgTSO *tso)
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
         belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
 #endif
+#ifdef PROFILING
+        // @LDV profiling
+        // We pretend that bh is now dead.
+        LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
 	SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+        // @LDV profiling
+        // We pretend that bh has just been created.
+        LDV_recordCreate(bh);
+#endif
       }
 
       update_frame = update_frame->link;
@@ -3811,7 +3894,20 @@ threadSqueezeStack(StgTSO *tso)
 	      }
 	  }
 #endif
+#ifdef PROFILING
+          // @LDV profiling
+          // We pretend that bh is now dead.
+          LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
+          // 
+          // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+          // 
 	  SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+          // @LDV profiling
+          // We pretend that bh has just been created.
+          LDV_recordCreate(bh);
+#endif
 	}
       }