[project @ 2001-01-24 15:46:19 by simonmar]

[ghc-hetmet.git] / ghc / rts / Storage.c

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 382acd3..1119519 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.28 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Storage.c,v 1.33 2001/01/24 15:46:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -61,7 +61,7 @@ void
 initStorage (void)
 {
   nat g, s;
-  step *step;
+  step *stp;
   generation *gen;
 
   /* If we're doing heap profiling, we want a two-space heap with a
@@ -130,19 +130,19 @@ initStorage (void)
   /* Initialise all steps */
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (s = 0; s < generations[g].n_steps; s++) {
-      step = &generations[g].steps[s];
-      step->no = s;
-      step->blocks = NULL;
-      step->n_blocks = 0;
-      step->gen = &generations[g];
-      step->hp = NULL;
-      step->hpLim = NULL;
-      step->hp_bd = NULL;
-      step->scan = NULL;
-      step->scan_bd = NULL;
-      step->large_objects = NULL;
-      step->new_large_objects = NULL;
-      step->scavenged_large_objects = NULL;
+      stp = &generations[g].steps[s];
+      stp->no = s;
+      stp->blocks = NULL;
+      stp->n_blocks = 0;
+      stp->gen = &generations[g];
+      stp->hp = NULL;
+      stp->hpLim = NULL;
+      stp->hp_bd = NULL;
+      stp->scan = NULL;
+      stp->scan_bd = NULL;
+      stp->large_objects = NULL;
+      stp->new_large_objects = NULL;
+      stp->scavenged_large_objects = NULL;
     }
   }
   
@@ -196,7 +196,6 @@ exitStorage (void)
     stat_exit(calcAllocated());
 }
 
-
 /* -----------------------------------------------------------------------------
    CAF management.
    -------------------------------------------------------------------------- */
@@ -217,6 +216,16 @@ newCAF(StgClosure* caf)
   ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
   oldest_gen->mut_once_list = (StgMutClosure *)caf;
 
+#ifdef GHCI
+  /* For dynamically-loaded code, we retain all the CAFs.  There is no
+   * way of knowing which ones we'll need in the future.
+   */
+  if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
+      caf->payload[2] = caf_list; /* IND_STATIC_LINK2() */
+      caf_list = caf;
+  }
+#endif
+
 #ifdef INTERPRETER
   /* If we're Hugs, we also have to put it in the CAF table, so that
      the CAF can be reverted.  When reverting, CAFs created by compiled
@@ -232,6 +241,18 @@ newCAF(StgClosure* caf)
   RELEASE_LOCK(&sm_mutex);
 }
 
+#ifdef GHCI
+void
+markCafs( void )
+{
+    StgClosure *p;
+
+    for (p = caf_list; p != NULL; p = STATIC_LINK2(get_itbl(p),p)) {
+       MarkRoot(p);
+    }
+}
+#endif /* GHCI */
+
 #ifdef INTERPRETER
 void
 newCAF_made_by_Hugs(StgCAF* caf)
@@ -592,7 +613,7 @@ calcLive(void)
 {
   nat g, s;
   lnat live = 0;
-  step *step;
+  step *stp;
 
   if (RtsFlags.GcFlags.generations == 1) {
     live = (g0s0->to_blocks - 1) * BLOCK_SIZE_W + 
@@ -608,9 +629,9 @@ calcLive(void)
       if (g == 0 && s == 0) { 
          continue; 
       }
-      step = &generations[g].steps[s];
-      live += (step->n_blocks - 1) * BLOCK_SIZE_W +
-       ((lnat)step->hp_bd->free - (lnat)step->hp_bd->start) / sizeof(W_);
+      stp = &generations[g].steps[s];
+      live += (stp->n_blocks - 1) * BLOCK_SIZE_W +
+       ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) / sizeof(W_);
     }
   }
   return live;
@@ -628,16 +649,16 @@ calcNeeded(void)
 {
   lnat needed = 0;
   nat g, s;
-  step *step;
+  step *stp;
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (s = 0; s < generations[g].n_steps; s++) {
       if (g == 0 && s == 0) { continue; }
-      step = &generations[g].steps[s];
+      stp = &generations[g].steps[s];
       if (generations[g].steps[0].n_blocks > generations[g].max_blocks) {
-       needed += 2 * step->n_blocks;
+       needed += 2 * stp->n_blocks;
       } else {
-       needed += step->n_blocks;
+       needed += stp->n_blocks;
       }
     }
   }
@@ -658,7 +679,7 @@ extern void
 memInventory(void)
 {
   nat g, s;
-  step *step;
+  step *stp;
   bdescr *bd;
   lnat total_blocks = 0, free_blocks = 0;
 
@@ -666,13 +687,13 @@ memInventory(void)
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (s = 0; s < generations[g].n_steps; s++) {
-      step = &generations[g].steps[s];
-      total_blocks += step->n_blocks;
+      stp = &generations[g].steps[s];
+      total_blocks += stp->n_blocks;
       if (RtsFlags.GcFlags.generations == 1) {
        /* two-space collector has a to-space too :-) */
        total_blocks += g0s0->to_blocks;
       }
-      for (bd = step->large_objects; bd; bd = bd->link) {
+      for (bd = stp->large_objects; bd; bd = bd->link) {
        total_blocks += bd->blocks;
        /* hack for megablock groups: they have an extra block or two in
           the second and subsequent megablocks where the block