Small optimisation: allocate nursery blocks contiguously

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

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 6aedb96..2e43bff 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -107,7 +107,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((StgWord)&stg_BLACKHOLE_info));
+  ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLOCKING_QUEUE_CLEAN_info));
   ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
   ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
   
@@ -177,8 +177,8 @@ initStorage( void )
   allocNurseries();
 
   weak_ptr_list = NULL;
-  caf_list = NULL;
-  revertible_caf_list = NULL;
+  caf_list = END_OF_STATIC_LIST;
+  revertible_caf_list = END_OF_STATIC_LIST;
    
   /* initialise the allocate() interface */
   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
@@ -229,13 +229,12 @@ freeStorage (void)
 
    The entry code for every CAF does the following:
      
-      - builds a CAF_BLACKHOLE in the heap
-      - pushes an update frame pointing to the CAF_BLACKHOLE
-      - invokes UPD_CAF(), which:
-          - calls newCaf, below
-         - updates the CAF with a static indirection to the CAF_BLACKHOLE
+      - builds a BLACKHOLE in the heap
+      - pushes an update frame pointing to the BLACKHOLE
+      - calls newCaf, below
+      - updates the CAF with a static indirection to the BLACKHOLE
       
-   Why do we build a BLACKHOLE in the heap rather than just updating
+   Why do we build an BLACKHOLE in the heap rather than just updating
    the thunk directly?  It's so that we only need one kind of update
    frame - otherwise we'd need a static version of the update frame too.
 
@@ -291,7 +290,9 @@ newCAF(StgRegTable *reg, StgClosure* caf)
   {
     // Put this CAF on the mutable list for the old generation.
     ((StgIndStatic *)caf)->saved_info = NULL;
-    recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
+    if (oldest_gen->no != 0) {
+        recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
+    }
   }
 }
 
@@ -331,31 +332,45 @@ static bdescr *
 allocNursery (bdescr *tail, nat blocks)
 {
     bdescr *bd;
-    nat i;
+    nat i, n;
 
-    // Allocate a nursery: we allocate fresh blocks one at a time and
-    // cons them on to the front of the list, not forgetting to update
-    // the back pointer on the tail of the list to point to the new block.
-    for (i=0; i < blocks; i++) {
-       // @LDV profiling
-       /*
-         processNursery() in LdvProfile.c assumes that every block group in
-         the nursery contains only a single block. So, if a block group is
-         given multiple blocks, change processNursery() accordingly.
-       */
-       bd = allocBlock();
-       bd->link = tail;
-       // double-link the nursery: we might need to insert blocks
-       if (tail != NULL) {
-           tail->u.back = bd;
-       }
-        initBdescr(bd, g0, g0);
-       bd->flags = 0;
-       bd->free = bd->start;
-       tail = bd;
+    // We allocate the nursery as a single contiguous block and then
+    // divide it into single blocks manually.  This way we guarantee
+    // that the nursery blocks are adjacent, so that the processor's
+    // automatic prefetching works across nursery blocks.  This is a
+    // tiny optimisation (~0.5%), but it's free.
+
+    while (blocks > 0) {
+        n = stg_min(blocks, BLOCKS_PER_MBLOCK);
+        blocks -= n;
+
+        bd = allocGroup(n);
+        for (i = 0; i < n; i++) {
+            initBdescr(&bd[i], g0, g0);
+
+            bd[i].blocks = 1;
+            bd[i].flags = 0;
+
+            if (i > 0) {
+                bd[i].u.back = &bd[i-1];
+            }
+
+            if (i+1 < n) {
+                bd[i].link = &bd[i+1];
+            } else {
+                bd[i].link = tail;
+                if (tail != NULL) {
+                    tail->u.back = &bd[i];
+                }
+            }
+
+            bd[i].free = bd[i].start;
+        }
+
+        tail = &bd[0];
     }
-    tail->u.back = NULL;
-    return tail;
+
+    return &bd[0];
 }
 
 static void
@@ -699,11 +714,9 @@ 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);
+        recordClosureMutated(cap,p);
     }
 }
 
@@ -716,22 +729,28 @@ dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
 void
 setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
 {
-    bdescr *bd;
     if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
         tso->flags |= TSO_LINK_DIRTY;
-       bd = Bdescr((StgPtr)tso);
-       if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+        recordClosureMutated(cap,(StgClosure*)tso);
     }
     tso->_link = target;
 }
 
 void
+setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
+{
+    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
+        tso->flags |= TSO_LINK_DIRTY;
+        recordClosureMutated(cap,(StgClosure*)tso);
+    }
+    tso->block_info.prev = target;
+}
+
+void
 dirty_TSO (Capability *cap, StgTSO *tso)
 {
-    bdescr *bd;
     if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
-       bd = Bdescr((StgPtr)tso);
-       if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no);
+        recordClosureMutated(cap,(StgClosure*)tso);
     }
     tso->dirty = 1;
 }
@@ -747,10 +766,7 @@ dirty_TSO (Capability *cap, StgTSO *tso)
 void
 dirty_MVAR(StgRegTable *reg, StgClosure *p)
 {
-    Capability *cap = regTableToCapability(reg);
-    bdescr *bd;
-    bd = Bdescr((StgPtr)p);
-    if (bd->gen_no > 0) recordMutableCap(p,cap,bd->gen_no);
+    recordClosureMutated(regTableToCapability(reg),p);
 }
 
 /* -----------------------------------------------------------------------------