[project @ 2006-01-17 16:13:18 by simonmar]

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

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index f4e3bab..28ccf79 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -56,7 +56,7 @@ step *nurseries         = NULL; /* array of nurseries, >1 only if SMP */
  * simultaneous access by two STG threads.
  */
 #ifdef SMP
-Mutex sm_mutex = INIT_MUTEX_VAR;
+Mutex sm_mutex;
 #endif
 
 /*
@@ -129,6 +129,8 @@ initStorage( void )
   initMutex(&sm_mutex);
 #endif
 
+  ACQUIRE_SM_LOCK;
+
   /* allocate generation info array */
   generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
                                             * sizeof(struct generation_),
@@ -172,7 +174,7 @@ initStorage( void )
   }
 
 #ifdef SMP
-  n_nurseries = RtsFlags.ParFlags.nNodes;
+  n_nurseries = n_capabilities;
   nurseries = stgMallocBytes (n_nurseries * sizeof(struct step_),
                              "initStorage: nurseries");
 #else
@@ -220,7 +222,7 @@ initStorage( void )
 #ifdef SMP
   if (RtsFlags.GcFlags.generations == 1) {
       errorBelch("-G1 is incompatible with SMP");
-      stg_exit(1);
+      stg_exit(EXIT_FAILURE);
   }
 #endif
 
@@ -250,6 +252,8 @@ initStorage( void )
   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 
   IF_DEBUG(gc, statDescribeGens());
+
+  RELEASE_SM_LOCK;
 }
 
 void
@@ -625,7 +629,7 @@ tidyAllocateLists (void)
    -------------------------------------------------------------------------- */
 
 StgPtr
-allocateLocal( StgRegTable *reg, nat n )
+allocateLocal (Capability *cap, nat n)
 {
     bdescr *bd;
     StgPtr p;
@@ -652,36 +656,36 @@ allocateLocal( StgRegTable *reg, nat n )
        /* small allocation (<LARGE_OBJECT_THRESHOLD) */
     } else {
 
-       bd = reg->rCurrentAlloc;
+       bd = cap->r.rCurrentAlloc;
        if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
 
            // The CurrentAlloc block is full, we need to find another
            // one.  First, we try taking the next block from the
            // nursery:
-           bd = reg->rCurrentNursery->link;
+           bd = cap->r.rCurrentNursery->link;
 
            if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
                // The nursery is empty, or the next block is already
                // full: allocate a fresh block (we can't fail here).
                ACQUIRE_SM_LOCK;
                bd = allocBlock();
-               reg->rNursery->n_blocks++;
+               cap->r.rNursery->n_blocks++;
                RELEASE_SM_LOCK;
                bd->gen_no = 0;
-               bd->step = g0s0;
+               bd->step = cap->r.rNursery;
                bd->flags = 0;
            } else {
                // we have a block in the nursery: take it and put
                // it at the *front* of the nursery list, and use it
                // to allocate() from.
-               reg->rCurrentNursery->link = bd->link;
+               cap->r.rCurrentNursery->link = bd->link;
                if (bd->link != NULL) {
-                   bd->link->u.back = reg->rCurrentNursery;
+                   bd->link->u.back = cap->r.rCurrentNursery;
                }
            }
-           dbl_link_onto(bd, &reg->rNursery->blocks);
-           reg->rCurrentAlloc = bd;
-           IF_DEBUG(sanity, checkNurserySanity(reg->rNursery));
+           dbl_link_onto(bd, &cap->r.rNursery->blocks);
+           cap->r.rCurrentAlloc = bd;
+           IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
        }
     }
     p = bd->free;
@@ -755,6 +759,22 @@ allocatePinned( nat n )
 }
 
 /* -----------------------------------------------------------------------------
+   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A
+   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
+   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
+   and is put on the mutable list.
+   -------------------------------------------------------------------------- */
+
+void
+dirty_MUT_VAR(StgClosure *p)
+{
+    if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
+       p->header.info = &stg_MUT_VAR_DIRTY_info;
+       recordMutable(p);
+    }
+}
+
+/* -----------------------------------------------------------------------------
    Allocation functions for GMP.
 
    These all use the allocate() interface - we can't have any garbage
@@ -777,9 +797,9 @@ stgAllocForGMP (size_t size_in_bytes)
   
   /* allocate and fill it in. */
 #if defined(SMP)
-  arr = (StgArrWords *)allocateLocal(&(myCapability()->r), total_size_in_words);
+  arr = (StgArrWords *)allocateLocal(myTask()->cap, total_size_in_words);
 #else
-  arr = (StgArrWords *)allocateLocal(&MainCapability.r, total_size_in_words);
+  arr = (StgArrWords *)allocateLocal(&MainCapability, total_size_in_words);
 #endif
   SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
   
@@ -950,6 +970,7 @@ stepBlocks (step *stp)
     bdescr *bd;
 
     total_blocks = stp->n_blocks;    
+    total_blocks += stp->n_old_blocks;
     for (bd = stp->large_objects; bd; bd = bd->link) {
        total_blocks += bd->blocks;
        /* hack for megablock groups: they have an extra block or two in
@@ -975,6 +996,11 @@ memInventory(void)
   /* count the blocks we current have */
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      for (i = 0; i < n_capabilities; i++) {
+         for (bd = capabilities[i].mut_lists[g]; bd != NULL; bd = bd->link) {
+             total_blocks += bd->blocks;
+         }
+      }          
       for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
          total_blocks += bd->blocks;
       }
@@ -988,11 +1014,10 @@ memInventory(void)
   for (i = 0; i < n_nurseries; i++) {
       total_blocks += stepBlocks(&nurseries[i]);
   }
-
-  if (RtsFlags.GcFlags.generations == 1) {
-      /* two-space collector has a to-space too :-) */
-      total_blocks += g0s0->n_old_blocks;
-  }
+#ifdef SMP
+  // We put pinned object blocks in g0s0, so better count blocks there too.
+  total_blocks += stepBlocks(g0s0);
+#endif
 
   /* any blocks held by allocate() */
   for (bd = small_alloc_list; bd; bd = bd->link) {