Add profiling of spinlocks

[ghc-hetmet.git] / rts / sm / Evac.c-inc

diff --git a/rts/sm/Evac.c-inc b/rts/sm/Evac.c-inc
index 0f2cc6d..752fe92 100644 (file)
--- a/rts/sm/Evac.c-inc
+++ b/rts/sm/Evac.c-inc
@@ -30,10 +30,15 @@ copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp, StgWord tag)
     StgWord info;
 
 #if !defined(MINOR_GC) && defined(THREADED_RTS)
-    do {
+spin:
        info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
        // so..  what is it?
-    } while (info == (W_)&stg_WHITEHOLE_info);
+    if (info == (W_)&stg_WHITEHOLE_info) {
+#ifdef PROF_SPIN
+           whitehole_spin++;
+#endif
+           goto spin;
+    }
     if (info == (W_)&stg_EVACUATED_info || info == (W_)&stg_IND_info) {
         // NB. a closure might be updated with an IND by
         // unchain_selector_thunks(), hence the test above.
@@ -88,12 +93,18 @@ copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy,
     StgWord info;
     
 #if !defined(MINOR_GC) && defined(THREADED_RTS)
-    do {
+spin:
        info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
-    } while (info == (W_)&stg_WHITEHOLE_info);
+       if (info == (W_)&stg_WHITEHOLE_info) {
+#ifdef PROF_SPIN
+           whitehole_spin++;
+#endif
+           goto spin;
+       }
     if (info == (W_)&stg_EVACUATED_info) {
        src->header.info = (const StgInfoTable *)info;
-       return evacuate(p); // does the failed_to_evac stuff
+       evacuate(p); // does the failed_to_evac stuff
+       return ;
     }
 #else
     info = (W_)src->header.info;