From 4d2db16b2606865a364ef3353e3c04abd167c5b1 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Wed, 20 Jan 1999 16:07:43 +0000
Subject: [PATCH] [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.
---
 ghc/compiler/absCSyn/CLabel.lhs |    4 ++--
 ghc/rts/GC.c                    |   32 ++++++++++++++++++--------------
 2 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index f0641fa..0dfdb1c 100644
--- 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
--- 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);
 	}
       }
-- 
1.7.10.4