From bf739c105b606764ae81a437f3cd9893c977db2f Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Tue, 2 Feb 1999 14:21:34 +0000
Subject: [PATCH] [project @ 1999-02-02 14:21:28 by simonm] - Add ticky counter
 for total bytes copied during GC. - Separate mutable list into two lists, a
 "mut once" list for   old generation indirections and MUT_CONS cells, and a
 "mut many"   list for mutable arrays, TSOs etc.  Objects on the "mut once"
 list   will be eagerly promoted.

---
 ghc/includes/StgTicky.h    |  11 +-
 ghc/rts/GC.c               | 204 +++++++++++++++++++++----------------
 ghc/rts/Schedule.c         |   6 +-
 ghc/rts/Stats.c            |  13 ++-
 ghc/rts/StgMiscClosures.hc |   4 +-
 ghc/rts/Storage.c          |  27 +----
 ghc/rts/Storage.h          |  32 +++++-
 ghc/rts/StoragePriv.h      |   3 +-
 ghc/rts/Ticky.c            |   6 +-
 9 files changed, 179 insertions(+), 127 deletions(-)

diff --git a/ghc/includes/StgTicky.h b/ghc/includes/StgTicky.h
index fe756a146356..014569e0f707 100644
--- a/ghc/includes/StgTicky.h
+++ b/ghc/includes/StgTicky.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: StgTicky.h,v 1.1 1999/01/21 10:31:44 simonm Exp $
+ * $Id: StgTicky.h,v 1.2 1999/02/02 14:21:28 simonm Exp $
  *
  * Ticky-ticky profiling macros.
  *
@@ -249,6 +249,12 @@
  */
 #define TICK_GC_FAILED_PROMOTION()	GC_FAILED_PROMOTION_ctr++
 
+/* Bytes copied: this is a fairly good measure of GC cost and depends
+ * on all sorts of things like number of generations, aging, eager
+ * promotion, generation sizing policy etc.
+ */
+#define TICK_GC_WORDS_COPIED(n)         GC_WORDS_COPIED_ctr+=(n)
+
 /* -----------------------------------------------------------------------------
    The accumulators (extern decls)
    -------------------------------------------------------------------------- */
@@ -457,6 +463,8 @@ EXTERN unsigned long GC_SEL_MAJOR_ctr INIT(0);
 
 EXTERN unsigned long GC_FAILED_PROMOTION_ctr INIT(0);
 
+EXTERN unsigned long GC_WORDS_COPIED_ctr INIT(0);
+
 #undef INIT
 #undef EXTERN
 
@@ -522,6 +530,7 @@ EXTERN unsigned long GC_FAILED_PROMOTION_ctr INIT(0);
 #define TICK_GC_SEL_MAJOR()
 
 #define TICK_GC_FAILED_PROMOTION()
+#define TICK_GC_WORDS_COPIED(n)
 
 #endif /* !TICKY_TICKY */
 
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 17c056da8822..a5abcd95e923 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.22 1999/01/28 15:04:00 simonm Exp $
+ * $Id: GC.c,v 1.23 1999/02/02 14:21:29 simonm Exp $
  *
  * Two-space garbage collector
  *
@@ -104,6 +104,7 @@ static void           scavenge_large(step *step);
 static void           scavenge(step *step);
 static void           scavenge_static(void);
 static StgMutClosure *scavenge_mutable_list(StgMutClosure *p, nat gen);
+static StgMutClosure *scavenge_mut_once_list(StgMutClosure *p, nat gen);
 
 #ifdef DEBUG
 static void gcCAFs(void);
@@ -191,7 +192,7 @@ void GarbageCollect(void (*get_roots)(void))
    * zeroMutableList below).
    */
   if (major_gc) { 
-    zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_list);
+    zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
   }
 
   /* Save the old to-space if we're doing a two-space collection
@@ -205,6 +206,7 @@ void GarbageCollect(void (*get_roots)(void))
    * collecting.
    */
   for (g = 0; g <= N; g++) {
+    generations[g].mut_once_list = END_MUT_LIST;
     generations[g].mut_list = END_MUT_LIST;
 
     for (s = 0; s < generations[g].n_steps; s++) {
@@ -289,6 +291,12 @@ void GarbageCollect(void (*get_roots)(void))
       generations[g].mut_list = END_MUT_LIST;
     }
 
+    /* Do the mut-once lists first */
+    for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
+      generations[g].mut_once_list = 
+	scavenge_mut_once_list(generations[g].mut_once_list, g);
+    }
+
     for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
       tmp = scavenge_mutable_list(generations[g].saved_mut_list, g);
       pp = &generations[g].mut_list;
@@ -815,6 +823,7 @@ copy(StgClosure *src, nat size, step *step)
 {
   P_ to, from, dest;
 
+  TICK_GC_WORDS_COPIED(size);
   /* Find out where we're going, using the handy "to" pointer in 
    * the step of the source object.  If it turns out we need to
    * evacuate to an older generation, adjust it here (see comment
@@ -850,6 +859,7 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step)
 {
   P_ dest, to, from;
 
+  TICK_GC_WORDS_COPIED(size_to_copy);
   if (step->gen->no < evac_gen) {
     step = &generations[evac_gen].steps[0];
   }
@@ -876,25 +886,6 @@ upd_evacuee(StgClosure *p, StgClosure *dest)
   q->evacuee = dest;
 }
 
-/* -----------------------------------------------------------------------------
-   Evacuate a mutable object
-   
-   If we evacuate a mutable object to an old generation, cons the
-   object onto the older generation's mutable list.
-   -------------------------------------------------------------------------- */
-   
-static inline void
-evacuate_mutable(StgMutClosure *c)
-{
-  bdescr *bd;
-  
-  bd = Bdescr((P_)c);
-  if (bd->gen->no > 0) {
-    c->mut_link = bd->gen->mut_list;
-    bd->gen->mut_list = c;
-  }
-}
-
 /* -----------------------------------------------------------------------------
    Evacuate a large object
 
@@ -952,7 +943,7 @@ evacuate_large(StgPtr p, rtsBool mutable)
   bd->evacuated = 1;
 
   if (mutable) {
-    evacuate_mutable((StgMutClosure *)p);
+    recordMutable((StgMutClosure *)p);
   }
 }
 
@@ -984,7 +975,7 @@ mkMutCons(StgClosure *ptr, generation *gen)
 
   SET_HDR(q,&MUT_CONS_info,CCS_GC);
   q->var = ptr;
-  evacuate_mutable((StgMutClosure *)q);
+  recordOldToNewPtrs((StgMutClosure *)q);
 
   return (StgClosure *)q;
 }
@@ -1054,10 +1045,11 @@ loop:
     return to;
 
   case MUT_VAR:
+    ASSERT(q->header.info != &MUT_CONS_info);
   case MVAR:
     to = copy(q,sizeW_fromITBL(info),step);
     upd_evacuee(q,to);
-    evacuate_mutable((StgMutClosure *)to);
+    recordMutable((StgMutClosure *)to);
     return to;
 
   case STABLE_NAME:
@@ -1111,7 +1103,7 @@ loop:
   case BLACKHOLE_BQ:
     to = copy(q,BLACKHOLE_sizeW(),step); 
     upd_evacuee(q,to);
-    evacuate_mutable((StgMutClosure *)to);
+    recordMutable((StgMutClosure *)to);
     return to;
 
   case THUNK_SELECTOR:
@@ -1275,7 +1267,7 @@ loop:
 	/*	fprintf(stderr,"evac failed!\n");*/
 	failed_to_evac = rtsTrue;
 	TICK_GC_FAILED_PROMOTION();
-      } 
+      }
     }
     return ((StgEvacuated*)q)->evacuee;
 
@@ -1308,7 +1300,7 @@ loop:
 	to = copy(q,size,step);
 	upd_evacuee(q,to);
 	if (info->type == MUT_ARR_PTRS) {
-	  evacuate_mutable((StgMutClosure *)to);
+	  recordMutable((StgMutClosure *)to);
 	}
       }
       return to;
@@ -1342,7 +1334,7 @@ loop:
 	relocate_TSO(tso, new_tso);
 	upd_evacuee(q,(StgClosure *)new_tso);
 
-	evacuate_mutable((StgMutClosure *)new_tso);
+	recordMutable((StgMutClosure *)new_tso);
 	return (StgClosure *)new_tso;
       }
     }
@@ -1595,7 +1587,7 @@ scavenge(step *step)
 	  evacuate((StgClosure *)bh->blocking_queue);
 	if (failed_to_evac) {
 	  failed_to_evac = rtsFalse;
-	  evacuate_mutable((StgMutClosure *)bh);
+	  recordMutable((StgMutClosure *)bh);
 	}
 	p += BLACKHOLE_sizeW();
 	break;
@@ -1681,7 +1673,7 @@ scavenge(step *step)
 	}
 	if (failed_to_evac) {
 	  /* we can do this easier... */
-	  evacuate_mutable((StgMutClosure *)start);
+	  recordMutable((StgMutClosure *)start);
 	  failed_to_evac = rtsFalse;
 	}
 	break;
@@ -1733,15 +1725,15 @@ scavenge(step *step)
    objects can have this property.
    -------------------------------------------------------------------------- */
 static rtsBool
-scavenge_one(StgPtr p)
+scavenge_one(StgClosure *p)
 {
   StgInfoTable *info;
   rtsBool no_luck;
 
-  ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
-	       || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
+  ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
+	       || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
 
-  info = get_itbl((StgClosure *)p);
+  info = get_itbl(p);
 
   switch (info -> type) {
 
@@ -1770,11 +1762,11 @@ scavenge_one(StgPtr p)
   case CAF_UNENTERED:
   case CAF_ENTERED:
     {
-      StgPtr end;
+      StgPtr q, end;
       
-      end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-      for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-	(StgClosure *)*p = evacuate((StgClosure *)*p);
+      end = (P_)p->payload + info->layout.payload.ptrs;
+      for (q = (P_)p->payload; q < end; q++) {
+	(StgClosure *)*q = evacuate((StgClosure *)*q);
       }
       break;
     }
@@ -1787,7 +1779,7 @@ scavenge_one(StgPtr p)
     { 
       StgSelector *s = (StgSelector *)p;
       s->selectee = evacuate(s->selectee);
-       break;
+      break;
     }
     
   case AP_UPD: /* same as PAPs */
@@ -1796,7 +1788,7 @@ scavenge_one(StgPtr p)
      * evacuate the function pointer too...
      */
     { 
-      StgPAP* pap = stgCast(StgPAP*,p);
+      StgPAP* pap = (StgPAP *)p;
       
       pap->fun = evacuate(pap->fun);
       scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
@@ -1829,6 +1821,83 @@ scavenge_one(StgPtr p)
    remove non-mutable objects from the mutable list at this point.
    -------------------------------------------------------------------------- */
 
+static StgMutClosure *
+scavenge_mut_once_list(StgMutClosure *p, nat gen)
+{
+  StgInfoTable *info;
+  StgMutClosure *start;
+  StgMutClosure **prev;
+
+  prev = &start;
+  start = p;
+
+  evac_gen = gen;
+  failed_to_evac = rtsFalse;
+
+  for (; p != END_MUT_LIST; p = *prev) {
+
+    /* make sure the info pointer is into text space */
+    ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
+		 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
+    
+    info = get_itbl(p);
+    switch(info->type) {
+      
+    case IND_OLDGEN:
+    case IND_OLDGEN_PERM:
+    case IND_STATIC:
+      /* Try to pull the indirectee into this generation, so we can
+       * remove the indirection from the mutable list.  
+       */
+      ((StgIndOldGen *)p)->indirectee = 
+        evacuate(((StgIndOldGen *)p)->indirectee);
+      
+      /* failed_to_evac might happen if we've got more than two
+       * generations, we're collecting only generation 0, the
+       * indirection resides in generation 2 and the indirectee is
+       * in generation 1.
+       */
+      if (failed_to_evac) {
+	failed_to_evac = rtsFalse;
+	prev = &p->mut_link;
+      } else {
+	*prev = p->mut_link;
+	/* the mut_link field of an IND_STATIC is overloaded as the
+	 * static link field too (it just so happens that we don't need
+	 * both at the same time), so we need to NULL it out when
+	 * removing this object from the mutable list because the static
+	 * link fields are all assumed to be NULL before doing a major
+	 * collection. 
+	 */
+	p->mut_link = NULL;
+      }
+      continue;
+      
+    case MUT_VAR:
+      /* MUT_CONS is a kind of MUT_VAR, except it that we try to remove
+       * it from the mutable list if possible by promoting whatever it
+       * points to.
+       */
+      ASSERT(p->header.info == &MUT_CONS_info);
+      if (scavenge_one(((StgMutVar *)p)->var) == rtsTrue) {
+	/* didn't manage to promote everything, so leave the
+	 * MUT_CONS on the list.
+	 */
+	prev = &p->mut_link;
+      } else {
+	*prev = p->mut_link;
+      }
+      continue;
+      
+    default:
+      /* shouldn't have anything else on the mutables list */
+      barf("scavenge_mut_once_list: strange object?");
+    }
+  }
+  return start;
+}
+
+
 static StgMutClosure *
 scavenge_mutable_list(StgMutClosure *p, nat gen)
 {
@@ -1893,21 +1962,9 @@ scavenge_mutable_list(StgMutClosure *p, nat gen)
        * it from the mutable list if possible by promoting whatever it
        * points to.
        */
-      if (p->header.info == &MUT_CONS_info) {
-	evac_gen = gen;
-	if (scavenge_one((P_)((StgMutVar *)p)->var) == rtsTrue) {
-	  /* didn't manage to promote everything, so leave the
-	   * MUT_CONS on the list.
-	   */
-	  prev = &p->mut_link;
-	} else {
-	  *prev = p->mut_link;
-	}
-	evac_gen = 0;
-      } else {
-	((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	prev = &p->mut_link;
-      }
+      ASSERT(p->header.info != &MUT_CONS_info);
+      ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
+      prev = &p->mut_link;
       continue;
       
     case MVAR:
@@ -1943,33 +2000,6 @@ scavenge_mutable_list(StgMutClosure *p, nat gen)
 	continue;
       }
       
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-    case IND_STATIC:
-      /* Try to pull the indirectee into this generation, so we can
-       * remove the indirection from the mutable list.  
-       */
-      evac_gen = gen;
-      ((StgIndOldGen *)p)->indirectee = 
-        evacuate(((StgIndOldGen *)p)->indirectee);
-      evac_gen = 0;
-
-      if (failed_to_evac) {
-	failed_to_evac = rtsFalse;
-	prev = &p->mut_link;
-      } else {
-	*prev = p->mut_link;
-	/* the mut_link field of an IND_STATIC is overloaded as the
-	 * static link field too (it just so happens that we don't need
-	 * both at the same time), so we need to NULL it out when
-	 * removing this object from the mutable list because the static
-	 * link fields are all assumed to be NULL before doing a major
-	 * collection. 
-	 */
-	p->mut_link = NULL;
-      }
-      continue;
-      
     case BLACKHOLE_BQ:
       { 
 	StgBlockingQueue *bh = (StgBlockingQueue *)p;
@@ -1981,7 +2011,7 @@ scavenge_mutable_list(StgMutClosure *p, nat gen)
 
     default:
       /* shouldn't have anything else on the mutables list */
-      barf("scavenge_mutable_object: non-mutable object?");
+      barf("scavenge_mut_list: strange object?");
     }
   }
   return start;
@@ -2029,8 +2059,8 @@ scavenge_static(void)
 	if (failed_to_evac) {
 	  failed_to_evac = rtsFalse;
 	  scavenged_static_objects = STATIC_LINK(info,p);
-	  ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_list;
-	  oldest_gen->mut_list = (StgMutClosure *)ind;
+	  ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_once_list;
+	  oldest_gen->mut_once_list = (StgMutClosure *)ind;
 	}
 	break;
       }
@@ -2168,7 +2198,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	    to = copy(frame->updatee, BLACKHOLE_sizeW(), step);
 	    upd_evacuee(frame->updatee,to);
 	    frame->updatee = to;
-	    evacuate_mutable((StgMutClosure *)to);
+	    recordMutable((StgMutClosure *)to);
 	    continue;
 	  default:
 	    barf("scavenge_stack: UPDATE_FRAME updatee");
@@ -2303,7 +2333,7 @@ scavenge_large(step *step)
 	}
 	evac_gen = 0;
 	if (failed_to_evac) {
-	  evacuate_mutable((StgMutClosure *)start);
+	  recordMutable((StgMutClosure *)start);
 	}
 	continue;
       }
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 1cdaa0c22ba1..f7de47a2d7d3 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.6 1999/01/26 11:12:48 simonm Exp $
+ * $Id: Schedule.c,v 1.7 1999/02/02 14:21:31 simonm Exp $
  *
  * Scheduler
  *
@@ -399,7 +399,9 @@ SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
     /* Be friendly to the storage manager: we're about to *run* this
      * thread, so we better make sure the TSO is mutable.
      */
-    recordMutable((StgMutClosure *)t);
+    if (t->mut_link == NULL) {
+      recordMutable((StgMutClosure *)t);
+    }
 
     /* Run the current thread */
     switch (t->whatNext) {
diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c
index 1cbc0ba236b7..91d3eba9ba65 100644
--- a/ghc/rts/Stats.c
+++ b/ghc/rts/Stats.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.3 1999/01/13 17:25:46 simonm Exp $
+ * $Id: Stats.c,v 1.4 1999/02/02 14:21:32 simonm Exp $
  *
  * Statistics and timing-related functions.
  *
@@ -396,19 +396,22 @@ stat_exit(int alloc)
 void
 stat_describe_gens(void)
 {
-  nat g, s, mut, lge, live;
+  nat g, s, mut, mut_once, lge, live;
   StgMutClosure *m;
   bdescr *bd;
   step *step;
 
-  fprintf(stderr, "     Gen    Steps      Max   Mutable   Step  Blocks     Live    Large\n"       "                    Blocks  Closures                          Objects\n");
+  fprintf(stderr, "     Gen    Steps      Max   Mutable  Mut-Once  Step  Blocks     Live    Large\n                    Blocks  Closures  Closures                         Objects\n");
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (m = generations[g].mut_list, mut = 0; m != END_MUT_LIST; 
 	 m = m->mut_link) 
       mut++;
-    fprintf(stderr, "%8d %8d %8d %9d", g, generations[g].n_steps,
-	    generations[g].max_blocks, mut);
+    for (m = generations[g].mut_once_list, mut_once = 0; m != END_MUT_LIST; 
+	 m = m->mut_link) 
+      mut_once++;
+    fprintf(stderr, "%8d %8d %8d %9d %8d", g, generations[g].n_steps,
+	    generations[g].max_blocks, mut, mut_once);
 
     for (s = 0; s < generations[g].n_steps; s++) {
       step = &generations[g].steps[s];
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index e724233cbee9..aac2de287f84 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.10 1999/02/01 18:05:34 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.11 1999/02/02 14:21:32 simonm Exp $
  *
  * Entry code for various built-in closure types.
  *
@@ -143,7 +143,6 @@ STGFUN(BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
@@ -178,7 +177,6 @@ STGFUN(CAF_BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 1f080c58a754..2c8dc38dcdf7 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.8 1999/01/28 15:04:02 simonm Exp $
+ * $Id: Storage.c,v 1.9 1999/02/02 14:21:33 simonm Exp $
  *
  * Storage manager front end
  *
@@ -68,6 +68,7 @@ initStorage (void)
     gen = &generations[g];
     gen->no = g;
     gen->mut_list = END_MUT_LIST;
+    gen->mut_once_list = END_MUT_LIST;
     gen->collections = 0;
     gen->failed_promotions = 0;
     gen->max_blocks = RtsFlags.GcFlags.minOldGenSize;
@@ -224,26 +225,6 @@ exitStorage (void)
   stat_exit(allocated);
 }
 
-void
-recordMutable(StgMutClosure *p)
-{
-  bdescr *bd;
-
-  ASSERT(closure_MUTABLE(p));
-
-  bd = Bdescr((P_)p);
-
-  /* no need to bother in generation 0 */
-  if (bd->gen == g0) { 
-    return; 
-  } 
-
-  if (p->mut_link == NULL) {
-    p->mut_link = bd->gen->mut_list;
-    bd->gen->mut_list = p;
-  }
-}
-
 void
 newCAF(StgClosure* caf)
 {
@@ -254,8 +235,8 @@ newCAF(StgClosure* caf)
    * come to do a major GC we won't need the mut_link field
    * any more and can use it as a STATIC_LINK.
    */
-  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_list;
-  oldest_gen->mut_list = (StgMutClosure *)caf;
+  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+  oldest_gen->mut_once_list = (StgMutClosure *)caf;
 
 #ifdef DEBUG
   { 
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index 35c46b3aa93a..b4a22b98f3b9 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.5 1999/01/21 10:31:52 simonm Exp $
+ * $Id: Storage.h,v 1.6 1999/02/02 14:21:34 simonm Exp $
  *
  * External Storage Manger Interface
  *
@@ -91,7 +91,31 @@ extern StgClosure *MarkRoot(StgClosure *p);
 
    -------------------------------------------------------------------------- */
 
-extern void recordMutable(StgMutClosure *p);
+static inline void
+recordMutable(StgMutClosure *p)
+{
+  bdescr *bd;
+
+  ASSERT(closure_MUTABLE(p));
+
+  bd = Bdescr((P_)p);
+  if (bd->gen->no > 0) {
+    p->mut_link = bd->gen->mut_list;
+    bd->gen->mut_list = p;
+  }
+}
+
+static inline void
+recordOldToNewPtrs(StgMutClosure *p)
+{
+  bdescr *bd;
+  
+  bd = Bdescr((P_)p);
+  if (bd->gen->no > 0) {
+    p->mut_link = bd->gen->mut_once_list;
+    bd->gen->mut_once_list = p;
+  }
+}
 
 static inline void
 updateWithIndirection(StgClosure *p1, StgClosure *p2) 
@@ -106,8 +130,8 @@ updateWithIndirection(StgClosure *p1, StgClosure *p2)
   } else {
     SET_INFO(p1,&IND_OLDGEN_info);
     ((StgIndOldGen *)p1)->indirectee = p2;
-    ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_list;
-    bd->gen->mut_list = (StgMutClosure *)p1;
+    ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
+    bd->gen->mut_once_list = (StgMutClosure *)p1;
     TICK_UPD_OLD_IND();
   }
 }
diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index 1c3266c04c0e..f36e1bf35ae3 100644
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.6 1999/01/28 15:04:02 simonm Exp $
+ * $Id: StoragePriv.h,v 1.7 1999/02/02 14:21:34 simonm Exp $
  *
  * Internal Storage Manger Interface
  *
@@ -71,6 +71,7 @@ typedef struct _generation {
   nat n_steps;			/* number of steps */
   nat max_blocks;		/* max blocks in step 0 */
   StgMutClosure *mut_list;      /* mutable objects in this generation (not G0)*/
+  StgMutClosure *mut_once_list; /* objects that point to younger generations */
 
   /* temporary use during GC: */
   StgMutClosure *saved_mut_list;
diff --git a/ghc/rts/Ticky.c b/ghc/rts/Ticky.c
index 1cfe5c717d5d..787b066b919a 100644
--- a/ghc/rts/Ticky.c
+++ b/ghc/rts/Ticky.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Ticky.c,v 1.1 1999/01/21 10:31:52 simonm Exp $
+ * $Id: Ticky.c,v 1.2 1999/02/02 14:21:34 simonm Exp $
  *
  * (c) The GHC Team, Glasgow University, 1992-1998
  *
@@ -261,6 +261,9 @@ PrintTickyInfo(void)
 	      PC(INTAVG(tot_old_updates,tot_gengc_updates)));
   }
 
+  fprintf(tf,"\nTotal bytes copied during GC: %ld\n",
+	  GC_WORDS_COPIED_ctr * sizeof(W_));
+
 #if 0
   printRegisteredCounterInfo(tf);
 #endif
@@ -478,6 +481,7 @@ PrintTickyInfo(void)
   PR_CTR(GC_SEL_MINOR_ctr);
   PR_CTR(GC_SEL_MAJOR_ctr);
   PR_CTR(GC_FAILED_PROMOTION_ctr);
+  PR_CTR(GC_WORDS_COPIED_ctr);
 }
 
 #if 0
-- 
GitLab