X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=ab2047036d48943c4ad19c3e84a2a970339e9d1d;hb=fcc3794aeb78081c04103a0b7e7560cb8c7bea58;hp=78f0f315d2c44de4893258d7bda2c6251740aeef;hpb=b339c8b1d0f239031802555b454062e9430ec8bb;p=ghc-hetmet.git

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 78f0f31..ab20470 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -21,6 +21,7 @@
 #include "Compact.h"
 #include "Prelude.h"
 #include "LdvProfile.h"
+#include "Trace.h"
 
 #if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC)
 StgWord64 whitehole_spin = 0;
@@ -85,7 +86,7 @@ alloc_for_copy (nat size, step *stp)
    The evacuate() code
    -------------------------------------------------------------------------- */
 
-STATIC_INLINE void
+STATIC_INLINE GNUC_ATTR_HOT void
 copy_tag(StgClosure **p, const StgInfoTable *info, 
          StgClosure *src, nat size, step *stp, StgWord tag)
 {
@@ -217,13 +218,82 @@ spin:
 
 
 /* Copy wrappers that don't tag the closure after copying */
-STATIC_INLINE void
+STATIC_INLINE GNUC_ATTR_HOT void
 copy(StgClosure **p, const StgInfoTable *info, 
      StgClosure *src, nat size, step *stp)
 {
     copy_tag(p,info,src,size,stp,0);
 }
 
+/* -----------------------------------------------------------------------------
+   Evacuate a large object
+
+   This just consists of removing the object from the (doubly-linked)
+   step->large_objects list, and linking it on to the (singly-linked)
+   step->new_large_objects list, from where it will be scavenged later.
+
+   Convention: bd->flags has BF_EVACUATED set for a large object
+   that has been evacuated, or unset otherwise.
+   -------------------------------------------------------------------------- */
+
+STATIC_INLINE void
+evacuate_large(StgPtr p)
+{
+  bdescr *bd = Bdescr(p);
+  step *stp, *new_stp;
+  step_workspace *ws;
+    
+  stp = bd->step;
+  ACQUIRE_SPIN_LOCK(&stp->sync_large_objects);
+
+  // object must be at the beginning of the block (or be a ByteArray)
+  ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS ||
+	 (((W_)p & BLOCK_MASK) == 0));
+
+  // already evacuated? 
+  if (bd->flags & BF_EVACUATED) { 
+    /* Don't forget to set the gct->failed_to_evac flag if we didn't get
+     * the desired destination (see comments in evacuate()).
+     */
+    if (stp < gct->evac_step) {
+	gct->failed_to_evac = rtsTrue;
+	TICK_GC_FAILED_PROMOTION();
+    }
+    RELEASE_SPIN_LOCK(&stp->sync_large_objects);
+    return;
+  }
+
+  // remove from large_object list 
+  if (bd->u.back) {
+    bd->u.back->link = bd->link;
+  } else { // first object in the list 
+    stp->large_objects = bd->link;
+  }
+  if (bd->link) {
+    bd->link->u.back = bd->u.back;
+  }
+  
+  /* link it on to the evacuated large object list of the destination step
+   */
+  new_stp = stp->to;
+  if (new_stp < gct->evac_step) {
+      if (gct->eager_promotion) {
+	  new_stp = gct->evac_step;
+      } else {
+	  gct->failed_to_evac = rtsTrue;
+      }
+  }
+
+  ws = &gct->steps[new_stp->abs_no];
+  bd->flags |= BF_EVACUATED;
+  bd->step = new_stp;
+  bd->gen_no = new_stp->gen_no;
+  bd->link = ws->todo_large_objects;
+  ws->todo_large_objects = bd;
+
+  RELEASE_SPIN_LOCK(&stp->sync_large_objects);
+}
+
 /* ----------------------------------------------------------------------------
    Evacuate
 
@@ -266,7 +336,7 @@ copy(StgClosure **p, const StgInfoTable *info,
    extra reads/writes than we save.
    ------------------------------------------------------------------------- */
 
-REGPARM1 void
+REGPARM1 GNUC_ATTR_HOT void 
 evacuate(StgClosure **p)
 {
   bdescr *bd = NULL;
@@ -383,7 +453,7 @@ loop:
 
   bd = Bdescr((P_)q);
 
-  if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) {
+  if ((bd->flags & (BF_LARGE | BF_MARKED | BF_EVACUATED)) != 0) {
 
       // pointer into to-space: just return it.  It might be a pointer
       // into a generation that we aren't collecting (> N), or it
@@ -419,17 +489,16 @@ loop:
       /* If the object is in a step that we're compacting, then we
        * need to use an alternative evacuate procedure.
        */
-      if (bd->flags & BF_COMPACTED) {
-	  if (!is_marked((P_)q,bd)) {
-	      mark((P_)q,bd);
-	      if (mark_stack_full()) {
-		  mark_stack_overflowed = rtsTrue;
-		  reset_mark_stack();
-	      }
-	      push_mark_stack((P_)q);
-	  }
-	  return;
+      if (!is_marked((P_)q,bd)) {
+          mark((P_)q,bd);
+          if (mark_stack_full()) {
+              debugTrace(DEBUG_gc,"mark stack overflowed");
+              mark_stack_overflowed = rtsTrue;
+              reset_mark_stack();
+          }
+          push_mark_stack((P_)q);
       }
+      return;
   }
       
   stp = bd->step->to;
@@ -672,75 +741,6 @@ loop:
 }
 
 /* -----------------------------------------------------------------------------
-   Evacuate a large object
-
-   This just consists of removing the object from the (doubly-linked)
-   step->large_objects list, and linking it on to the (singly-linked)
-   step->new_large_objects list, from where it will be scavenged later.
-
-   Convention: bd->flags has BF_EVACUATED set for a large object
-   that has been evacuated, or unset otherwise.
-   -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-evacuate_large(StgPtr p)
-{
-  bdescr *bd = Bdescr(p);
-  step *stp, *new_stp;
-  step_workspace *ws;
-    
-  stp = bd->step;
-  ACQUIRE_SPIN_LOCK(&stp->sync_large_objects);
-
-  // object must be at the beginning of the block (or be a ByteArray)
-  ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS ||
-	 (((W_)p & BLOCK_MASK) == 0));
-
-  // already evacuated? 
-  if (bd->flags & BF_EVACUATED) { 
-    /* Don't forget to set the gct->failed_to_evac flag if we didn't get
-     * the desired destination (see comments in evacuate()).
-     */
-    if (stp < gct->evac_step) {
-	gct->failed_to_evac = rtsTrue;
-	TICK_GC_FAILED_PROMOTION();
-    }
-    RELEASE_SPIN_LOCK(&stp->sync_large_objects);
-    return;
-  }
-
-  // remove from large_object list 
-  if (bd->u.back) {
-    bd->u.back->link = bd->link;
-  } else { // first object in the list 
-    stp->large_objects = bd->link;
-  }
-  if (bd->link) {
-    bd->link->u.back = bd->u.back;
-  }
-  
-  /* link it on to the evacuated large object list of the destination step
-   */
-  new_stp = stp->to;
-  if (new_stp < gct->evac_step) {
-      if (gct->eager_promotion) {
-	  new_stp = gct->evac_step;
-      } else {
-	  gct->failed_to_evac = rtsTrue;
-      }
-  }
-
-  ws = &gct->steps[new_stp->abs_no];
-  bd->flags |= BF_EVACUATED;
-  bd->step = new_stp;
-  bd->gen_no = new_stp->gen_no;
-  bd->link = ws->todo_large_objects;
-  ws->todo_large_objects = bd;
-
-  RELEASE_SPIN_LOCK(&stp->sync_large_objects);
-}
-
-/* -----------------------------------------------------------------------------
    Evaluate a THUNK_SELECTOR if possible.
 
    p points to a THUNK_SELECTOR that we want to evaluate.  The
@@ -828,7 +828,7 @@ selector_chain:
         // (scavenge_mark_stack doesn't deal with IND).  BEWARE!  This
         // bit is very tricky to get right.  If you make changes
         // around here, test by compiling stage 3 with +RTS -c -RTS.
-        if (bd->flags & BF_COMPACTED) {
+        if (bd->flags & BF_MARKED) {
             // must call evacuate() to mark this closure if evac==rtsTrue
             *q = (StgClosure *)p;
             if (evac) evacuate(q);