Specialise evac/scav for single-threaded, not minor, GC

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

diff --git a/rts/sm/Evac.c-inc b/rts/sm/Evac.c-inc
index 0f2cc6d..6f629f0 100644 (file)
--- a/rts/sm/Evac.c-inc
+++ b/rts/sm/Evac.c-inc
@@ -10,11 +10,11 @@
 // non-minor, parallel, GC.  This file contains the code for both,
 // controllled by the CPP symbol MINOR_GC.
 
-#ifdef MINOR_GC
-#define copy(a,b,c,d) copy0(a,b,c,d)
-#define copy_tag(a,b,c,d,e) copy_tag0(a,b,c,d,e)
-#define copyPart(a,b,c,d,e) copyPart0(a,b,c,d,e)
-#define evacuate(a) evacuate0(a)
+#ifndef PARALLEL_GC
+#define copy(a,b,c,d) copy1(a,b,c,d)
+#define copy_tag(a,b,c,d,e) copy_tag1(a,b,c,d,e)
+#define copyPart(a,b,c,d,e) copyPart1(a,b,c,d,e)
+#define evacuate(a) evacuate1(a)
 #else
 #undef copy
 #undef copy_tag
@@ -29,11 +29,16 @@ copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp, StgWord tag)
     nat i;
     StgWord info;
 
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
-    do {
+#if defined(PARALLEL_GC) && defined(THREADED_RTS)
+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.
@@ -63,7 +68,7 @@ copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp, StgWord tag)
 //  }
 
     ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
+#if defined(PARALLEL_GC) && defined(THREADED_RTS)
     write_barrier();
     ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
 #endif
@@ -87,13 +92,19 @@ copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy,
     nat i;
     StgWord info;
     
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
-    do {
+#if defined(PARALLEL_GC) && defined(THREADED_RTS)
+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;
@@ -112,7 +123,7 @@ copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy,
     }
     
     ((StgEvacuated*)from)->evacuee = (StgClosure *)to;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
+#if defined(PARALLEL_GC) && defined(THREADED_RTS)
     write_barrier();
     ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
 #endif
@@ -197,35 +208,45 @@ loop:
 
   if (!HEAP_ALLOCED(q)) {
 
-#ifdef MINOR_GC
-      return;
-#endif
       if (!major_gc) return;
 
       info = get_itbl(q);
       switch (info->type) {
 
       case THUNK_STATIC:
-         if (info->srt_bitmap != 0 &&
-             *THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
-             ACQUIRE_SPIN_LOCK(&static_objects_sync);
+         if (info->srt_bitmap != 0) {
              if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
-                 *THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
-                 static_objects = (StgClosure *)q;
+#ifndef THREADED_RTS
+                 *THUNK_STATIC_LINK((StgClosure *)q) = gct->static_objects;
+                 gct->static_objects = (StgClosure *)q;
+#else
+                  StgPtr link;
+                  link = (StgPtr)cas((StgPtr)THUNK_STATIC_LINK((StgClosure *)q),
+                                     (StgWord)NULL,
+                                     (StgWord)gct->static_objects);
+                  if (link == NULL) {
+                      gct->static_objects = (StgClosure *)q;
+                  }
+#endif
              }
-             RELEASE_SPIN_LOCK(&static_objects_sync);
          }
          return;
-         
+
       case FUN_STATIC:
          if (info->srt_bitmap != 0 &&
              *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
-             ACQUIRE_SPIN_LOCK(&static_objects_sync);
-             if (*FUN_STATIC_LINK((StgClosure *)q) == NULL) {
-                 *FUN_STATIC_LINK((StgClosure *)q) = static_objects;
-                 static_objects = (StgClosure *)q;
-             }
-             RELEASE_SPIN_LOCK(&static_objects_sync);
+#ifndef THREADED_RTS
+              *FUN_STATIC_LINK((StgClosure *)q) = gct->static_objects;
+              gct->static_objects = (StgClosure *)q;
+#else
+              StgPtr link;
+              link = (StgPtr)cas((StgPtr)FUN_STATIC_LINK((StgClosure *)q),
+                                 (StgWord)NULL,
+                                 (StgWord)gct->static_objects);
+              if (link == NULL) {
+                  gct->static_objects = (StgClosure *)q;
+              }
+#endif
          }
          return;
          
@@ -235,27 +256,40 @@ loop:
           * scavenge it later).
           */
          if (((StgIndStatic *)q)->saved_info == NULL) {
-             ACQUIRE_SPIN_LOCK(&static_objects_sync);
              if (*IND_STATIC_LINK((StgClosure *)q) == NULL) {
-                 *IND_STATIC_LINK((StgClosure *)q) = static_objects;
-                 static_objects = (StgClosure *)q;
+#ifndef THREADED_RTS
+                 *IND_STATIC_LINK((StgClosure *)q) = gct->static_objects;
+                 gct->static_objects = (StgClosure *)q;
+#else
+                  StgPtr link;
+                  link = (StgPtr)cas((StgPtr)IND_STATIC_LINK((StgClosure *)q),
+                                     (StgWord)NULL,
+                                     (StgWord)gct->static_objects);
+                  if (link == NULL) {
+                      gct->static_objects = (StgClosure *)q;
+                  }
+#endif
              }
-             RELEASE_SPIN_LOCK(&static_objects_sync);
          }
          return;
          
       case CONSTR_STATIC:
          if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
-             ACQUIRE_SPIN_LOCK(&static_objects_sync);
-             // re-test, after acquiring lock
-             if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
-                 *STATIC_LINK(info,(StgClosure *)q) = static_objects;
-                 static_objects = (StgClosure *)q;
-             }
-             RELEASE_SPIN_LOCK(&static_objects_sync);
-               /* I am assuming that static_objects pointers are not
-                * written to other objects, and thus, no need to retag. */
-         }
+#ifndef THREADED_RTS
+              *STATIC_LINK(info,(StgClosure *)q) = gct->static_objects;
+              gct->static_objects = (StgClosure *)q;
+#else
+              StgPtr link;
+              link = (StgPtr)cas((StgPtr)STATIC_LINK(info,(StgClosure *)q),
+                                 (StgWord)NULL,
+                                 (StgWord)gct->static_objects);
+              if (link == NULL) {
+                  gct->static_objects = (StgClosure *)q;
+              }
+#endif
+          }
+          /* I am assuming that static_objects pointers are not
+           * written to other objects, and thus, no need to retag. */
           return;
          
       case CONSTR_NOCAF_STATIC: