[project @ 2005-04-22 08:58:36 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 64cfacd..545ee1c 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -47,6 +47,12 @@
 
 #include <string.h>
 
+// Turn off inlining when debugging - it obfuscates things
+#ifdef DEBUG
+# undef  STATIC_INLINE
+# define STATIC_INLINE static
+#endif
+
 /* STATIC OBJECT LIST.
  *
  * During GC:
@@ -978,7 +984,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        blocks = RtsFlags.GcFlags.minAllocAreaSize;
       }
     }
-    resizeNursery(blocks);
+    resizeNurseries(blocks);
     
   } else {
     /* Generational collector:
@@ -995,7 +1001,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        * percentage of g0s0 that was live at the last minor GC.
        */
       if (N == 0) {
-       g0s0_pcnt_kept = (new_blocks * 100) / g0s0->n_blocks;
+       g0s0_pcnt_kept = (new_blocks * 100) / countNurseryBlocks();
       }
 
       /* Estimate a size for the allocation area based on the
@@ -1018,12 +1024,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        blocks = RtsFlags.GcFlags.minAllocAreaSize;
       }
       
-      resizeNursery((nat)blocks);
+      resizeNurseries((nat)blocks);
 
     } else {
       // we might have added extra large blocks to the nursery, so
       // resize back to minAllocAreaSize again.
-      resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
+      resizeNurseries(RtsFlags.GcFlags.minAllocAreaSize);
     }
   }
 
@@ -1990,6 +1996,48 @@ loop:
    been BLACKHOLE'd, and should be updated with an indirection or a
    forwarding pointer.  If the return value is NULL, then the selector
    thunk is unchanged.
+
+   ***
+   ToDo: the treatment of THUNK_SELECTORS could be improved in the
+   following way (from a suggestion by Ian Lynagh):
+
+   We can have a chain like this:
+
+      sel_0 --> (a,b)
+                 |
+                 |-----> sel_0 --> (a,b)
+                                    |
+                                    |-----> sel_0 --> ...
+
+   and the depth limit means we don't go all the way to the end of the
+   chain, which results in a space leak.  This affects the recursive
+   call to evacuate() in the THUNK_SELECTOR case in evacuate(): *not*
+   the recursive call to eval_thunk_selector() in
+   eval_thunk_selector().
+
+   We could eliminate the depth bound in this case, in the following
+   way:
+
+      - traverse the chain once to discover the *value* of the 
+        THUNK_SELECTOR.  Mark all THUNK_SELECTORS that we
+        visit on the way as having been visited already (somehow).
+
+      - in a second pass, traverse the chain again updating all
+        THUNK_SEELCTORS that we find on the way with indirections to
+        the value.
+
+      - if we encounter a "marked" THUNK_SELECTOR in a normal 
+        evacuate(), we konw it can't be updated so just evac it.
+
+   Program that illustrates the problem:
+
+       foo [] = ([], [])
+       foo (x:xs) = let (ys, zs) = foo xs
+                    in if x >= 0 then (x:ys, zs) else (ys, x:zs)
+
+       main = bar [1..(100000000::Int)]
+       bar xs = (\(ys, zs) -> print ys >> print zs) (foo xs)
+
    -------------------------------------------------------------------------- */
 
 static inline rtsBool
@@ -3938,7 +3986,7 @@ threadLazyBlackHole(StgTSO *tso)
            
            if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-               debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
+               debugBelch("Unexpected lazy BHing required at 0x%04x\n",(int)bh);
 #endif
 #ifdef PROFILING
                // @LDV profiling