X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=c903d3f90dff5a01a1c9ce011c52d6a54fb0d498;hb=ce492e0a23aa9741a629e5576547bd28e3c25c90;hp=3dd36f7df506a36e69c8f4bd2dc2cbd7017184a0;hpb=d381d2096a5386031a62d9826b9cd57901fce68d;p=ghc-hetmet.git

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 3dd36f7..c903d3f 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.23 2000/02/14 10:58:05 sewardj Exp $
+ * $Id: Storage.c,v 1.26 2000/07/14 13:28:35 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -14,7 +14,6 @@
 #include "Hooks.h"
 #include "BlockAlloc.h"
 #include "MBlock.h"
-#include "gmp.h"
 #include "Weak.h"
 #include "Sanity.h"
 
@@ -195,6 +194,11 @@ exitStorage (void)
   stat_exit(calcAllocated());
 }
 
+
+/* -----------------------------------------------------------------------------
+   CAF management.
+   -------------------------------------------------------------------------- */
+
 void
 newCAF(StgClosure* caf)
 {
@@ -206,24 +210,78 @@ newCAF(StgClosure* caf)
    * any more and can use it as a STATIC_LINK.
    */
   ACQUIRE_LOCK(&sm_mutex);
+
+  ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
   ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
   oldest_gen->mut_once_list = (StgMutClosure *)caf;
 
-#ifdef DEBUG
-  { 
-    const StgInfoTable *info;
-    
-    info = get_itbl(caf);
-    ASSERT(info->type == IND_STATIC);
-#if 0
-    STATIC_LINK2(info,caf) = caf_list;
-    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
+     code are recorded in the CAF table, which lives outside the
+     heap, in mallocville.  CAFs created by interpreted code are
+     chained together via the link fields in StgCAFs, and are not
+     recorded in the CAF table.
+  */
+  ASSERT( get_itbl(caf)->type == THUNK_STATIC );
+  addToECafTable ( caf, get_itbl(caf) );
 #endif
+
   RELEASE_LOCK(&sm_mutex);
 }
 
+#ifdef INTERPRETER
+void
+newCAF_made_by_Hugs(StgCAF* caf)
+{
+  ACQUIRE_LOCK(&sm_mutex);
+
+  ASSERT( get_itbl(caf)->type == CAF_ENTERED );
+  recordOldToNewPtrs((StgMutClosure*)caf);
+  caf->link = ecafList;
+  ecafList = caf->link;
+
+  RELEASE_LOCK(&sm_mutex);
+}
+#endif
+
+#ifdef INTERPRETER
+/* These initialisations are critical for correct operation
+   on the first call of addToECafTable. 
+*/
+StgCAF*         ecafList      = END_ECAF_LIST;
+StgCAFTabEntry* ecafTable     = NULL;
+StgInt          usedECafTable = 0;
+StgInt          sizeECafTable = 0;
+
+
+void clearECafTable ( void )
+{
+   usedECafTable = 0;
+}
+
+void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
+{
+   StgInt          i;
+   StgCAFTabEntry* et2;
+   if (usedECafTable == sizeECafTable) {
+      /* Make the initial table size be 8 */
+      sizeECafTable *= 2;
+      if (sizeECafTable == 0) sizeECafTable = 8;
+      et2 = stgMallocBytes ( 
+               sizeECafTable * sizeof(StgCAFTabEntry),
+               "addToECafTable" );
+      for (i = 0; i < usedECafTable; i++) 
+         et2[i] = ecafTable[i];
+      if (ecafTable) free(ecafTable);
+      ecafTable = et2;
+   }
+   ecafTable[usedECafTable].closure  = closure;
+   ecafTable[usedECafTable].origItbl = origItbl;
+   usedECafTable++;
+}
+#endif
+
 /* -----------------------------------------------------------------------------
    Nursery management.
    -------------------------------------------------------------------------- */
@@ -380,6 +438,7 @@ allocate(nat n)
      * (eg. running threads), so garbage collecting early won't make
      * much difference.
      */
+    alloc_blocks += req_blocks;
     RELEASE_LOCK(&sm_mutex);
     return bd->start;