[project @ 1999-01-20 16:07:40 by simonm]

The BLACKHOLEs created when entering a CAF for the first time are now
CAF_BLACKHOLES, distinguishing them from the blackholes created by
lazy blackholing.

This enables the lazy blackholing algorithm to be optimised by not
blackholing a section of stack that has already been traversed.

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index f0641fa..0dfdb1c 100644 (file)
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.22 1998/12/18 17:40:34 simonpj Exp $
+% $Id: CLabel.lhs,v 1.23 1999/01/20 16:07:43 simonm Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -393,7 +393,7 @@ pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
 
 pprCLbl (RtsLabel RtsUpdEntry) = ptext SLIT("Upd_frame_entry")
 
-pprCLbl (RtsLabel RtsBlackHoleInfoTbl) = ptext SLIT("BLACKHOLE_info")
+pprCLbl (RtsLabel RtsBlackHoleInfoTbl) = ptext SLIT("CAF_BLACKHOLE_info")
 
 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
   = hcat [ptext SLIT("__sel_"), text (show offset),

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 937a356..fb2eaa5 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.16 1999/01/19 17:22:55 simonm Exp $
+ * $Id: GC.c,v 1.17 1999/01/20 16:07:40 simonm Exp $
  *
  * Two-space garbage collector
  *
@@ -411,6 +411,7 @@ void GarbageCollect(void (*get_roots)(void))
             (int)oldest_gen->steps[0].to_blocks) < 
            (RtsFlags.GcFlags.pcFreeHeap *
             RtsFlags.GcFlags.maxHeapSize / 200)) {
+         heapOverflow();
        }
       }
     }
@@ -2382,15 +2383,16 @@ threadLazyBlackHole(StgTSO *tso)
       /* if the thunk is already blackholed, it means we've also
        * already blackholed the rest of the thunks on this stack,
        * so we can stop early.
+       *
+       * The blackhole made for a CAF is a CAF_BLACKHOLE, so they
+       * don't interfere with this optimisation.
        */
+      if (bh->header.info == &BLACKHOLE_info) {
+       return;
+      }
 
-      /* Don't for now: when we enter a CAF, we create a black hole on
-       * the heap and make the update frame point to it.  Thus the
-       * above optimisation doesn't apply.
-       */
-      if (bh->header.info != &BLACKHOLE_info
-         && bh->header.info != &BLACKHOLE_BQ_info
-         && bh->header.info != &CAF_BLACKHOLE_info) {
+      if (bh->header.info != &BLACKHOLE_BQ_info &&
+         bh->header.info != &CAF_BLACKHOLE_info) {
        SET_INFO(bh,&BLACKHOLE_info);
       }
 
@@ -2440,8 +2442,8 @@ threadSqueezeStack(StgTSO *tso)
    * added to the stack, rather than the way we see them in this
    * walk. (It makes the next loop less confusing.)  
    *
-   * Could stop if we find an update frame pointing to a black hole,
-   * but see comment in threadLazyBlackHole().
+   * Stop if we find an update frame pointing to a black hole 
+   * (see comment in threadLazyBlackHole()).
    */
   
   next_frame = NULL;
@@ -2450,6 +2452,10 @@ threadSqueezeStack(StgTSO *tso)
     frame->link = next_frame;
     next_frame = frame;
     frame = prev_frame;
+    if (get_itbl(frame)->type == UPDATE_FRAME
+       && frame->updatee->header.info == &BLACKHOLE_info) {
+        break;
+    }
   }
 
   /* Now, we're at the bottom.  Frame points to the lowest update
@@ -2547,10 +2553,8 @@ threadSqueezeStack(StgTSO *tso)
        */
       if (is_update_frame) {
        StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee;
-       if (bh->header.info != &BLACKHOLE_info
-           && bh->header.info != &BLACKHOLE_BQ_info
-           && bh->header.info != &CAF_BLACKHOLE_info
-           ) {
+       if (bh->header.info != &BLACKHOLE_BQ_info &&
+           bh->header.info != &CAF_BLACKHOLE_info) {
          SET_INFO(bh,&BLACKHOLE_info);
        }
       }