RTS tidyup sweep, first phase
[ghc-hetmet.git] / rts / sm / Storage.c
index db0299c..97615e9 100644 (file)
 
 #include "PosixSource.h"
 #include "Rts.h"
+
+#include "Storage.h"
 #include "RtsUtils.h"
-#include "RtsFlags.h"
 #include "Stats.h"
-#include "Hooks.h"
 #include "BlockAlloc.h"
-#include "MBlock.h"
 #include "Weak.h"
 #include "Sanity.h"
 #include "Arena.h"
-#include "OSThreads.h"
 #include "Capability.h"
-#include "Storage.h"
 #include "Schedule.h"
 #include "RetainerProfile.h"   // for counting memory blocks (memInventory)
 #include "OSMem.h"
 #include "GC.h"
 #include "Evac.h"
 
-#include <stdlib.h>
 #include <string.h>
 
+#include "ffi.h"
+
 /* 
  * All these globals require sm_mutex to access in THREADED_RTS mode.
  */
@@ -46,6 +44,8 @@ bdescr *pinned_object_block;    /* allocate pinned objects into this block */
 nat alloc_blocks;              /* number of allocate()d blocks since GC */
 nat alloc_blocks_lim;          /* approximate limit on alloc_blocks */
 
+static bdescr *exec_block;
+
 generation *generations = NULL;        /* all the generations */
 generation *g0         = NULL; /* generation 0, for convenience */
 generation *oldest_gen  = NULL; /* oldest generation, for convenience */
@@ -65,19 +65,9 @@ step *nurseries         = NULL; /* array of nurseries, >1 only if THREADED_RTS *
  * simultaneous access by two STG threads.
  */
 Mutex sm_mutex;
-/*
- * This mutex is used by atomicModifyMutVar# only
- */
-Mutex atomic_modify_mutvar_mutex;
 #endif
 
-
-/*
- * Forward references
- */
-static void *stgAllocForGMP   (size_t size_in_bytes);
-static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
-static void  stgDeallocForGMP (void *ptr, size_t size);
+static void allocNurseries ( void );
 
 static void
 initStep (step *stp, int g, int s)
@@ -87,6 +77,7 @@ initStep (step *stp, int g, int s)
     stp->blocks = NULL;
     stp->n_blocks = 0;
     stp->n_words = 0;
+    stp->live_estimate = 0;
     stp->old_blocks = NULL;
     stp->n_old_blocks = 0;
     stp->gen = &generations[g];
@@ -95,10 +86,10 @@ initStep (step *stp, int g, int s)
     stp->n_large_blocks = 0;
     stp->scavenged_large_objects = NULL;
     stp->n_scavenged_large_blocks = 0;
-    stp->is_compacted = 0;
+    stp->mark = 0;
+    stp->compact = 0;
     stp->bitmap = NULL;
 #ifdef THREADED_RTS
-    initSpinLock(&stp->sync_todo);
     initSpinLock(&stp->sync_large_objects);
 #endif
     stp->threads = END_TSO_QUEUE;
@@ -122,7 +113,7 @@ initStorage( void )
    * doing something reasonable.
    */
   /* We use the NOT_NULL variant or gcc warns that the test is always true */
-  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL(&stg_BLACKHOLE_info));
+  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLACKHOLE_info));
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
   ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
   
@@ -143,7 +134,6 @@ initStorage( void )
   
 #if defined(THREADED_RTS)
   initMutex(&sm_mutex);
-  initMutex(&atomic_modify_mutvar_mutex);
 #endif
 
   ACQUIRE_SM_LOCK;
@@ -230,11 +220,13 @@ initStorage( void )
   }
   
   /* The oldest generation has one step. */
-  if (RtsFlags.GcFlags.compact) {
+  if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) {
       if (RtsFlags.GcFlags.generations == 1) {
-         errorBelch("WARNING: compaction is incompatible with -G1; disabled");
+         errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled");
       } else {
-         oldest_gen->steps[0].is_compacted = 1;
+         oldest_gen->steps[0].mark = 1;
+          if (RtsFlags.GcFlags.compact)
+              oldest_gen->steps[0].compact = 1;
       }
   }
 
@@ -257,15 +249,17 @@ initStorage( void )
   alloc_blocks = 0;
   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 
-  /* Tell GNU multi-precision pkg about our custom alloc functions */
-  mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
+  exec_block = NULL;
 
 #ifdef THREADED_RTS
   initSpinLock(&gc_alloc_block_sync);
-  initSpinLock(&recordMutableGen_sync);
   whitehole_spin = 0;
 #endif
 
+  N = 0;
+
+  initGcThreads();
+
   IF_DEBUG(gc, statDescribeGens());
 
   RELEASE_SM_LOCK;
@@ -285,9 +279,9 @@ freeStorage (void)
     freeAllMBlocks();
 #if defined(THREADED_RTS)
     closeMutex(&sm_mutex);
-    closeMutex(&atomic_modify_mutvar_mutex);
 #endif
     stgFree(nurseries);
+    freeGcThreads();
 }
 
 /* -----------------------------------------------------------------------------
@@ -362,7 +356,7 @@ newCAF(StgClosure* caf)
     * any more and can use it as a STATIC_LINK.
     */
     ((StgIndStatic *)caf)->saved_info = NULL;
-    recordMutableGen(caf, oldest_gen);
+    recordMutableGen(caf, oldest_gen->no);
   }
   
   RELEASE_SM_LOCK;
@@ -443,7 +437,7 @@ assignNurseriesToCapabilities (void)
 #endif
 }
 
-void
+static void
 allocNurseries( void )
 { 
     nat i;
@@ -553,6 +547,22 @@ resizeNurseries (nat blocks)
     resizeNurseriesFixed(blocks / n_nurseries);
 }
 
+
+/* -----------------------------------------------------------------------------
+   move_TSO is called to update the TSO structure after it has been
+   moved from one place to another.
+   -------------------------------------------------------------------------- */
+
+void
+move_TSO (StgTSO *src, StgTSO *dest)
+{
+    ptrdiff_t diff;
+
+    // relocate the stack pointer... 
+    diff = (StgPtr)dest - (StgPtr)src; // In *words* 
+    dest->sp = (StgPtr)dest->sp + diff;
+}
+
 /* -----------------------------------------------------------------------------
    The allocate() interface
 
@@ -565,7 +575,7 @@ resizeNurseries (nat blocks)
    -------------------------------------------------------------------------- */
 
 StgPtr
-allocateInGen (generation *g, nat n)
+allocateInGen (generation *g, lnat n)
 {
     step *stp;
     bdescr *bd;
@@ -580,18 +590,26 @@ allocateInGen (generation *g, nat n)
 
     if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_))
     {
-       nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
+       lnat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
 
         // Attempting to allocate an object larger than maxHeapSize
         // should definitely be disallowed.  (bug #1791)
         if (RtsFlags.GcFlags.maxHeapSize > 0 && 
             req_blocks >= RtsFlags.GcFlags.maxHeapSize) {
             heapOverflow();
+            // heapOverflow() doesn't exit (see #2592), but we aren't
+            // in a position to do a clean shutdown here: we
+            // either have to allocate the memory or exit now.
+            // Allocating the memory would be bad, because the user
+            // has requested that we not exceed maxHeapSize, so we
+            // just exit.
+           stg_exit(EXIT_HEAPOVERFLOW);
         }
 
        bd = allocGroup(req_blocks);
        dbl_link_onto(bd, &stp->large_objects);
        stp->n_large_blocks += bd->blocks; // might be larger than req_blocks
+       alloc_blocks += bd->blocks;
        bd->gen_no  = g->no;
        bd->step = stp;
        bd->flags = BF_LARGE;
@@ -622,7 +640,7 @@ allocateInGen (generation *g, nat n)
 }
 
 StgPtr
-allocate (nat n)
+allocate (lnat n)
 {
     return allocateInGen(g0,n);
 }
@@ -641,8 +659,8 @@ allocatedBytes( void )
     return allocated;
 }
 
-// split N blocks off the start of the given bdescr, returning the 
-// remainder as a new block group.  We treat the remainder as if it
+// split N blocks off the front of the given bdescr, returning the
+// new block group.  We treat the remainder as if it
 // had been freshly allocated in generation 0.
 bdescr *
 splitLargeBlock (bdescr *bd, nat blocks)
@@ -660,6 +678,7 @@ splitLargeBlock (bdescr *bd, nat blocks)
     new_bd->step    = g0s0;
     new_bd->flags   = BF_LARGE;
     new_bd->free    = bd->free;
+    ASSERT(new_bd->free <= new_bd->start + new_bd->blocks * BLOCK_SIZE_W);
 
     // add the new number of blocks to the counter.  Due to the gaps
     // for block descriptor, new_bd->blocks + bd->blocks might not be
@@ -667,7 +686,7 @@ splitLargeBlock (bdescr *bd, nat blocks)
     bd->step->n_large_blocks += bd->blocks;
 
     return new_bd;
-}    
+}
 
 /* -----------------------------------------------------------------------------
    allocateLocal()
@@ -683,7 +702,7 @@ splitLargeBlock (bdescr *bd, nat blocks)
    -------------------------------------------------------------------------- */
 
 StgPtr
-allocateLocal (Capability *cap, nat n)
+allocateLocal (Capability *cap, lnat n)
 {
     bdescr *bd;
     StgPtr p;
@@ -717,7 +736,9 @@ allocateLocal (Capability *cap, nat n)
             bd->flags = 0;
             // NO: alloc_blocks++;
             // calcAllocated() uses the size of the nursery, and we've
-            // already bumpted nursery->n_blocks above.
+            // already bumpted nursery->n_blocks above.  We'll GC
+            // pretty quickly now anyway, because MAYBE_GC() will
+            // notice that CurrentNursery->link is NULL.
         } else {
             // we have a block in the nursery: take it and put
             // it at the *front* of the nursery list, and use it
@@ -760,7 +781,7 @@ allocateLocal (Capability *cap, nat n)
    ------------------------------------------------------------------------- */
 
 StgPtr
-allocatePinned( nat n )
+allocatePinned( lnat n )
 {
     StgPtr p;
     bdescr *bd = pinned_object_block;
@@ -768,7 +789,9 @@ allocatePinned( nat n )
     // If the request is for a large object, then allocate()
     // will give us a pinned object anyway.
     if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
-       return allocate(n);
+       p = allocate(n);
+        Bdescr(p)->flags |= BF_PINNED;
+        return p;
     }
 
     ACQUIRE_SM_LOCK;
@@ -776,13 +799,6 @@ allocatePinned( nat n )
     TICK_ALLOC_HEAP_NOCTR(n);
     CCS_ALLOC(CCCS,n);
 
-    // we always return 8-byte aligned memory.  bd->free must be
-    // 8-byte aligned to begin with, so we just round up n to
-    // the nearest multiple of 8 bytes.
-    if (sizeof(StgWord) == 4) {
-       n = (n+1) & ~1;
-    }
-
     // If we don't have a block of pinned objects yet, or the current
     // one isn't large enough to hold the new object, allocate a new one.
     if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
@@ -846,11 +862,11 @@ void
 dirty_TSO (Capability *cap, StgTSO *tso)
 {
     bdescr *bd;
-    if ((tso->flags & TSO_DIRTY) == 0) {
-        tso->flags |= TSO_DIRTY;
+    if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) {
        bd = Bdescr((StgPtr)tso);
        if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
     }
+    tso->flags |= TSO_DIRTY;
 }
 
 /*
@@ -871,61 +887,6 @@ dirty_MVAR(StgRegTable *reg, StgClosure *p)
 }
 
 /* -----------------------------------------------------------------------------
-   Allocation functions for GMP.
-
-   These all use the allocate() interface - we can't have any garbage
-   collection going on during a gmp operation, so we use allocate()
-   which always succeeds.  The gmp operations which might need to
-   allocate will ask the storage manager (via doYouWantToGC()) whether
-   a garbage collection is required, in case we get into a loop doing
-   only allocate() style allocation.
-   -------------------------------------------------------------------------- */
-
-static void *
-stgAllocForGMP (size_t size_in_bytes)
-{
-  StgArrWords* arr;
-  nat data_size_in_words, total_size_in_words;
-  
-  /* round up to a whole number of words */
-  data_size_in_words  = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
-  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
-  
-  /* allocate and fill it in. */
-#if defined(THREADED_RTS)
-  arr = (StgArrWords *)allocateLocal(myTask()->cap, total_size_in_words);
-#else
-  arr = (StgArrWords *)allocateLocal(&MainCapability, total_size_in_words);
-#endif
-  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
-  
-  /* and return a ptr to the goods inside the array */
-  return arr->payload;
-}
-
-static void *
-stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
-{
-    void *new_stuff_ptr = stgAllocForGMP(new_size);
-    nat i = 0;
-    char *p = (char *) ptr;
-    char *q = (char *) new_stuff_ptr;
-
-    for (; i < old_size; i++, p++, q++) {
-       *q = *p;
-    }
-
-    return(new_stuff_ptr);
-}
-
-static void
-stgDeallocForGMP (void *ptr STG_UNUSED, 
-                 size_t size STG_UNUSED)
-{
-    /* easy for us: the garbage collector does the dealloc'n */
-}
-
-/* -----------------------------------------------------------------------------
  * Stats and stuff
  * -------------------------------------------------------------------------- */
 
@@ -1016,6 +977,7 @@ countOccupied(bdescr *bd)
 
     words = 0;
     for (; bd != NULL; bd = bd->link) {
+        ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W);
         words += bd->free - bd->start;
     }
     return words;
@@ -1063,14 +1025,27 @@ calcNeeded(void)
        for (s = 0; s < generations[g].n_steps; s++) {
            if (g == 0 && s == 0) { continue; }
            stp = &generations[g].steps[s];
+
+            // we need at least this much space
+            needed += stp->n_blocks + stp->n_large_blocks;
+
+            // any additional space needed to collect this gen next time?
            if (g == 0 || // always collect gen 0
                 (generations[g].steps[0].n_blocks +
                  generations[g].steps[0].n_large_blocks 
-                 > generations[g].max_blocks
-                 && stp->is_compacted == 0)) {
-               needed += 2 * stp->n_blocks + stp->n_large_blocks;
-           } else {
-               needed += stp->n_blocks + stp->n_large_blocks;
+                 > generations[g].max_blocks)) {
+                // we will collect this gen next time
+                if (stp->mark) {
+                    //  bitmap:
+                    needed += stp->n_blocks / BITS_IN(W_);
+                    //  mark stack:
+                    needed += stp->n_blocks / 100;
+                }
+                if (stp->compact) {
+                    continue; // no additional space needed for compaction
+                } else {
+                    needed += stp->n_blocks;
+                }
            }
        }
     }
@@ -1097,9 +1072,37 @@ calcNeeded(void)
          should be modified to use allocateExec instead of VirtualAlloc.
    ------------------------------------------------------------------------- */
 
-static bdescr *exec_block;
+#if defined(linux_HOST_OS)
 
-void *allocateExec (nat bytes)
+// On Linux we need to use libffi for allocating executable memory,
+// because it knows how to work around the restrictions put in place
+// by SELinux.
+
+void *allocateExec (nat bytes, void **exec_ret)
+{
+    void **ret, **exec;
+    ACQUIRE_SM_LOCK;
+    ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec);
+    RELEASE_SM_LOCK;
+    if (ret == NULL) return ret;
+    *ret = ret; // save the address of the writable mapping, for freeExec().
+    *exec_ret = exec + 1;
+    return (ret + 1);
+}
+
+// freeExec gets passed the executable address, not the writable address. 
+void freeExec (void *addr)
+{
+    void *writable;
+    writable = *((void**)addr - 1);
+    ACQUIRE_SM_LOCK;
+    ffi_closure_free (writable);
+    RELEASE_SM_LOCK
+}
+
+#else
+
+void *allocateExec (nat bytes, void **exec_ret)
 {
     void *ret;
     nat n;
@@ -1135,6 +1138,7 @@ void *allocateExec (nat bytes)
     exec_block->free += n + 1;
 
     RELEASE_SM_LOCK
+    *exec_ret = ret;
     return ret;
 }
 
@@ -1172,6 +1176,8 @@ void freeExec (void *addr)
     RELEASE_SM_LOCK
 }    
 
+#endif /* mingw32_HOST_OS */
+
 /* -----------------------------------------------------------------------------
    Debugging
 
@@ -1236,6 +1242,51 @@ stepBlocks (step *stp)
            countAllocdBlocks(stp->large_objects);
 }
 
+// If memInventory() calculates that we have a memory leak, this
+// function will try to find the block(s) that are leaking by marking
+// all the ones that we know about, and search through memory to find
+// blocks that are not marked.  In the debugger this can help to give
+// us a clue about what kind of block leaked.  In the future we might
+// annotate blocks with their allocation site to give more helpful
+// info.
+static void
+findMemoryLeak (void)
+{
+  nat g, s, i;
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      for (i = 0; i < n_capabilities; i++) {
+         markBlocks(capabilities[i].mut_lists[g]);
+      }
+      markBlocks(generations[g].mut_list);
+      for (s = 0; s < generations[g].n_steps; s++) {
+         markBlocks(generations[g].steps[s].blocks);
+         markBlocks(generations[g].steps[s].large_objects);
+      }
+  }
+
+  for (i = 0; i < n_nurseries; i++) {
+      markBlocks(nurseries[i].blocks);
+      markBlocks(nurseries[i].large_objects);
+  }
+
+#ifdef PROFILING
+  // TODO:
+  // if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
+  //    markRetainerBlocks();
+  // }
+#endif
+
+  // count the blocks allocated by the arena allocator
+  // TODO:
+  // markArenaBlocks();
+
+  // count the blocks containing executable memory
+  markBlocks(exec_block);
+
+  reportUnmarkedBlocks();
+}
+
+
 void
 memInventory (rtsBool show)
 {
@@ -1292,6 +1343,7 @@ memInventory (rtsBool show)
 #define MB(n) (((n) * BLOCK_SIZE_W) / ((1024*1024)/sizeof(W_)))
 
   leak = live_blocks + free_blocks != mblocks_allocated * BLOCKS_PER_MBLOCK;
+
   if (show || leak)
   {
       if (leak) { 
@@ -1320,6 +1372,13 @@ memInventory (rtsBool show)
                      mblocks_allocated * BLOCKS_PER_MBLOCK, mblocks_allocated);
       }
   }
+
+  if (leak) {
+      debugBelch("\n");
+      findMemoryLeak();
+  }
+  ASSERT(n_alloc_blocks == live_blocks);
+  ASSERT(!leak);
 }
 
 
@@ -1331,7 +1390,7 @@ checkSanity( void )
 
     if (RtsFlags.GcFlags.generations == 1) {
        checkHeap(g0s0->blocks);
-       checkChain(g0s0->large_objects);
+       checkLargeObjects(g0s0->large_objects);
     } else {
        
        for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
@@ -1342,10 +1401,7 @@ checkSanity( void )
                ASSERT(countBlocks(generations[g].steps[s].large_objects)
                       == generations[g].steps[s].n_large_blocks);
                checkHeap(generations[g].steps[s].blocks);
-               checkChain(generations[g].steps[s].large_objects);
-               if (g > 0) {
-                   checkMutableList(generations[g].mut_list, g);
-               }
+               checkLargeObjects(generations[g].steps[s].large_objects);
            }
        }
 
@@ -1358,6 +1414,14 @@ checkSanity( void )
            
        checkFreeListSanity();
     }
+
+#if defined(THREADED_RTS)
+    // check the stacks too in threaded mode, because we don't do a
+    // full heap sanity check in this case (see checkHeap())
+    checkMutableLists(rtsTrue);
+#else
+    checkMutableLists(rtsFalse);
+#endif
 }
 
 /* Nursery sanity check */