GC: move static object processinng into thread-local storage

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

diff --git a/rts/sm/Evac.c-inc b/rts/sm/Evac.c-inc
index 367d277..e651418 100644 (file)
--- a/rts/sm/Evac.c-inc
+++ b/rts/sm/Evac.c-inc
@@ -1,4 +1,4 @@
-/* -----------------------------------------------------------------------------
+/* -----------------------------------------------------------------------*-c-*-
  *
  * (c) The GHC Team 1998-2006
  *
@@ -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;
@@ -206,26 +217,39 @@ loop:
       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 +259,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: