oops, initialize atomic_modify_mutvar_mutex
[ghc-hetmet.git] / ghc / rts / Storage.c
index 7e07ff2..4933854 100644 (file)
@@ -27,7 +27,7 @@
 #include <string.h>
 
 /* 
- * All these globals require sm_mutex to access in SMP mode.
+ * All these globals require sm_mutex to access in THREADED_RTS mode.
  */
 StgClosure    *caf_list         = NULL;
 StgClosure    *revertible_caf_list = NULL;
@@ -49,16 +49,21 @@ step *g0s0          = NULL; /* generation 0, step 0, for convenience */
 ullong total_allocated = 0;    /* total memory allocated during run */
 
 nat n_nurseries         = 0;    /* == RtsFlags.ParFlags.nNodes, convenience */
-step *nurseries         = NULL; /* array of nurseries, >1 only if SMP */
+step *nurseries         = NULL; /* array of nurseries, >1 only if THREADED_RTS */
 
+#ifdef THREADED_RTS
 /*
  * Storage manager mutex:  protects all the above state from
  * simultaneous access by two STG threads.
  */
-#ifdef SMP
-Mutex sm_mutex = INIT_MUTEX_VAR;
+Mutex sm_mutex;
+/*
+ * This mutex is used by atomicModifyMutVar# only
+ */
+Mutex atomic_modify_mutvar_mutex;
 #endif
 
+
 /*
  * Forward references
  */
@@ -71,13 +76,16 @@ initStep (step *stp, int g, int s)
 {
     stp->no = s;
     stp->blocks = NULL;
-    stp->n_to_blocks = 0;
     stp->n_blocks = 0;
+    stp->old_blocks = NULL;
+    stp->n_old_blocks = 0;
     stp->gen = &generations[g];
     stp->gen_no = g;
     stp->hp = NULL;
     stp->hpLim = NULL;
     stp->hp_bd = NULL;
+    stp->scavd_hp = NULL;
+    stp->scavd_hpLim = NULL;
     stp->scan = NULL;
     stp->scan_bd = NULL;
     stp->large_objects = NULL;
@@ -122,10 +130,13 @@ initStorage( void )
 
   initBlockAllocator();
   
-#if defined(SMP)
+#if defined(THREADED_RTS)
   initMutex(&sm_mutex);
+  initMutex(&atomic_modify_mutvar_mutex);
 #endif
 
+  ACQUIRE_SM_LOCK;
+
   /* allocate generation info array */
   generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
                                             * sizeof(struct generation_),
@@ -168,8 +179,8 @@ initStorage( void )
     g0->steps = stgMallocBytes (sizeof(struct step_), "initStorage: steps");
   }
 
-#ifdef SMP
-  n_nurseries = RtsFlags.ParFlags.nNodes;
+#ifdef THREADED_RTS
+  n_nurseries = n_capabilities;
   nurseries = stgMallocBytes (n_nurseries * sizeof(struct step_),
                              "initStorage: nurseries");
 #else
@@ -184,7 +195,7 @@ initStorage( void )
     }
   }
   
-#ifdef SMP
+#ifdef THREADED_RTS
   for (s = 0; s < n_nurseries; s++) {
       initStep(&nurseries[s], 0, s);
   }
@@ -199,7 +210,7 @@ initStorage( void )
   }
   oldest_gen->steps[0].to = &oldest_gen->steps[0];
   
-#ifdef SMP
+#ifdef THREADED_RTS
   for (s = 0; s < n_nurseries; s++) {
       nurseries[s].to = generations[0].steps[0].to;
   }
@@ -214,10 +225,10 @@ initStorage( void )
       }
   }
 
-#ifdef SMP
+#ifdef THREADED_RTS
   if (RtsFlags.GcFlags.generations == 1) {
-      errorBelch("-G1 is incompatible with SMP");
-      stg_exit(1);
+      errorBelch("-G1 is incompatible with -threaded");
+      stg_exit(EXIT_FAILURE);
   }
 #endif
 
@@ -247,6 +258,8 @@ initStorage( void )
   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 
   IF_DEBUG(gc, statDescribeGens());
+
+  RELEASE_SM_LOCK;
 }
 
 void
@@ -402,7 +415,7 @@ allocNursery (step *stp, bdescr *tail, nat blocks)
 static void
 assignNurseriesToCapabilities (void)
 {
-#ifdef SMP
+#ifdef THREADED_RTS
     nat i;
 
     for (i = 0; i < n_nurseries; i++) {
@@ -410,7 +423,7 @@ assignNurseriesToCapabilities (void)
        capabilities[i].r.rCurrentNursery = nurseries[i].blocks;
        capabilities[i].r.rCurrentAlloc   = NULL;
     }
-#else /* SMP */
+#else /* THREADED_RTS */
     MainCapability.r.rNursery        = &nurseries[0];
     MainCapability.r.rCurrentNursery = nurseries[0].blocks;
     MainCapability.r.rCurrentAlloc   = NULL;
@@ -427,8 +440,8 @@ allocNurseries( void )
            allocNursery(&nurseries[i], NULL, 
                         RtsFlags.GcFlags.minAllocAreaSize);
        nurseries[i].n_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
-       nurseries[i].to_blocks   = NULL;
-       nurseries[i].n_to_blocks = 0;
+       nurseries[i].old_blocks   = NULL;
+       nurseries[i].n_old_blocks = 0;
        /* hp, hpLim, hp_bd, to_space etc. aren't used in the nursery */
     }
     assignNurseriesToCapabilities();
@@ -622,7 +635,7 @@ tidyAllocateLists (void)
    -------------------------------------------------------------------------- */
 
 StgPtr
-allocateLocal( StgRegTable *reg, nat n )
+allocateLocal (Capability *cap, nat n)
 {
     bdescr *bd;
     StgPtr p;
@@ -649,34 +662,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();
-               alloc_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 = cap->r.rCurrentNursery;
+               }
            }
-           bd->link = reg->rNursery->blocks;
-           reg->rNursery->blocks = bd;
-           bd->u.back = NULL;
-           reg->rCurrentAlloc = bd;
+           dbl_link_onto(bd, &cap->r.rNursery->blocks);
+           cap->r.rCurrentAlloc = bd;
+           IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
        }
     }
     p = bd->free;
@@ -750,6 +765,25 @@ 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(StgRegTable *reg, StgClosure *p)
+{
+    Capability *cap = regTableToCapability(reg);
+    bdescr *bd;
+    if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
+       p->header.info = &stg_MUT_VAR_DIRTY_info;
+       bd = Bdescr((StgPtr)p);
+       if (bd->gen_no > 0) recordMutableCap(p,cap,bd->gen_no);
+    }
+}
+
+/* -----------------------------------------------------------------------------
    Allocation functions for GMP.
 
    These all use the allocate() interface - we can't have any garbage
@@ -771,10 +805,10 @@ stgAllocForGMP (size_t size_in_bytes)
   total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
   
   /* allocate and fill it in. */
-#if defined(SMP)
-  arr = (StgArrWords *)allocateLocal(&(myCapability()->r), total_size_in_words);
+#if defined(THREADED_RTS)
+  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);
   
@@ -822,12 +856,13 @@ calcAllocated( void )
 {
   nat allocated;
   bdescr *bd;
-  nat i;
 
   allocated = allocated_bytes();
   allocated += countNurseryBlocks() * BLOCK_SIZE_W;
   
-#ifdef SMP
+  {
+#ifdef THREADED_RTS
+  nat i;
   for (i = 0; i < n_nurseries; i++) {
       Capability *cap;
       for ( bd = capabilities[i].r.rCurrentNursery->link; 
@@ -852,6 +887,7 @@ calcAllocated( void )
          - current_nursery->free;
   }
 #endif
+  }
 
   total_allocated += allocated;
   return allocated;
@@ -868,7 +904,7 @@ calcLive(void)
   step *stp;
 
   if (RtsFlags.GcFlags.generations == 1) {
-    live = (g0s0->n_to_blocks - 1) * BLOCK_SIZE_W + 
+    live = (g0s0->n_blocks - 1) * BLOCK_SIZE_W + 
       ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
     return live;
   }
@@ -887,6 +923,9 @@ calcLive(void)
          live += ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) 
              / sizeof(W_);
       }
+      if (stp->scavd_hp != NULL) {
+         live -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
+      }
     }
   }
   return live;
@@ -940,6 +979,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
@@ -965,6 +1005,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;
       }
@@ -978,11 +1023,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_to_blocks;
-  }
+#ifdef THREADED_RTS
+  // 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) {
@@ -1029,7 +1073,7 @@ checkSanity( void )
     nat g, s;
 
     if (RtsFlags.GcFlags.generations == 1) {
-       checkHeap(g0s0->to_blocks);
+       checkHeap(g0s0->blocks);
        checkChain(g0s0->large_objects);
     } else {
        
@@ -1059,6 +1103,22 @@ checkSanity( void )
     }
 }
 
+/* Nursery sanity check */
+void
+checkNurserySanity( step *stp )
+{
+    bdescr *bd, *prev;
+    nat blocks = 0;
+
+    prev = NULL;
+    for (bd = stp->blocks; bd != NULL; bd = bd->link) {
+       ASSERT(bd->u.back == prev);
+       prev = bd;
+       blocks += bd->blocks;
+    }
+    ASSERT(blocks == stp->n_blocks);
+}
+
 // handy function for use in gdb, because Bdescr() is inlined.
 extern bdescr *_bdescr( StgPtr p );