[project @ 2000-11-13 14:40:36 by simonmar]

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

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index ec0728a..382acd3 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.21 1999/11/09 15:46:59 simonmar Exp $
+ * $Id: Storage.c,v 1.28 2000/11/13 14:40:37 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"
 
@@ -41,6 +40,8 @@ generation *g0;                       /* generation 0, for convenience */
 generation *oldest_gen;                /* oldest generation, for convenience */
 step *g0s0;                    /* generation 0, step 0, for convenience */
 
+lnat total_allocated = 0;      /* total memory allocated during run */
+
 /*
  * Storage manager mutex:  protects all the above state from
  * simultaneous access by two STG threads.
@@ -179,10 +180,8 @@ initStorage (void)
   alloc_blocks = 0;
   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 
-#ifdef COMPILER
   /* Tell GNU multi-precision pkg about our custom alloc functions */
   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
-#endif
 
 #ifdef SMP
   pthread_mutex_init(&sm_mutex, NULL);
@@ -194,9 +193,14 @@ initStorage (void)
 void
 exitStorage (void)
 {
-  stat_exit(calcAllocated());
+    stat_exit(calcAllocated());
 }
 
+
+/* -----------------------------------------------------------------------------
+   CAF management.
+   -------------------------------------------------------------------------- */
+
 void
 newCAF(StgClosure* caf)
 {
@@ -208,24 +212,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.
    -------------------------------------------------------------------------- */
@@ -270,7 +328,7 @@ resetNurseries( void )
   Capability *cap;
   
   /* All tasks must be stopped */
-  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes);
+  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
 
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
     for (bd = cap->rNursery; bd; bd = bd->link) {
@@ -382,6 +440,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;
 
@@ -437,7 +496,7 @@ stgAllocForGMP (size_t size_in_bytes)
   
   /* allocate and fill it in. */
   arr = (StgArrWords *)allocate(total_size_in_words);
-  SET_ARR_HDR(arr, &ARR_WORDS_info, CCCS, data_size_in_words);
+  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
   
   /* and return a ptr to the goods inside the array */
   return(BYTE_ARR_CTS(arr));
@@ -491,7 +550,7 @@ calcAllocated( void )
      capabilities are owned by the scheduler, though: one or more
      tasks might have been stopped while they were running (non-main)
      threads. */
-  /*  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes); */
+  /*  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */
 
   allocated = 
     n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
@@ -521,6 +580,7 @@ calcAllocated( void )
   }
 #endif
 
+  total_allocated += allocated;
   return allocated;
 }