Eliminate zero_static_objects_list()

Summary:
In a workload with a large amount of code, zero_static_objects_list()
takes a significant amount of time, and furthermore it is in the
single-threaded part of the GC.

This patch uses a slightly fiddly scheme for marking objects on the
static object lists, using a flag in the low 2 bits that flips between
two states to indicate whether an object has been visited during this
GC or not.  We also have to take into account objects that have not
been visited yet, which might appear at any time due to runtime linking.

Test Plan: validate

Reviewers: austin, bgamari, ezyang, rwbarton

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1076

11 files changed, 134 insertions, 119 deletions

diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index 2c01113f63..34f976db4d 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -271,7 +271,8 @@ void checkUnload (StgClosure *static_objects)
 
   addrs = allocHashTable();
 
-  for (p = static_objects; p != END_OF_STATIC_LIST; p = link) {
+  for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) {
+      p = UNTAG_STATIC_LIST_PTR(p);
       checkAddress(addrs, p);
       info = get_itbl(p);
       link = *STATIC_LINK(info, p);
@@ -279,8 +280,9 @@ void checkUnload (StgClosure *static_objects)
 
   // CAFs on revertible_caf_list are not on static_objects
   for (p = (StgClosure*)revertible_caf_list;
-       p != END_OF_STATIC_LIST;
+       p != END_OF_CAF_LIST;
        p = ((StgIndStatic *)p)->static_link) {
+      p = UNTAG_STATIC_LIST_PTR(p);
       checkAddress(addrs, p);
   }
 
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 78daa892ad..8121defbf8 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1881,7 +1881,7 @@ resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
     count = 0;
 #endif
     p = static_objects;
-    while (p != END_OF_STATIC_LIST) {
+    while (p != END_OF_STATIC_OBJECT_LIST) {
 #ifdef DEBUG_RETAINER
         count++;
 #endif
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index a053dc3b4e..4ee88da11c 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -197,8 +197,8 @@ thread_static( StgClosure* p )
 
   // keep going until we've threaded all the objects on the linked
   // list...
-  while (p != END_OF_STATIC_LIST) {
-
+  while (p != END_OF_STATIC_OBJECT_LIST) {
+    p = UNTAG_STATIC_LIST_PTR(p);
     info = get_itbl(p);
     switch (info->type) {
 
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index b0ef807768..bc8cb9ad13 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -324,6 +324,38 @@ evacuate_large(StgPtr p)
 }
 
 /* ----------------------------------------------------------------------------
+   Evacuate static objects
+
+   When a static object is visited for the first time in this GC, it
+   is chained on to the gct->static_objects list.
+
+   evacuate_static_object (link_field, q)
+     - link_field must be STATIC_LINK(q)
+   ------------------------------------------------------------------------- */
+
+STATIC_INLINE void
+evacuate_static_object (StgClosure **link_field, StgClosure *q)
+{
+    StgWord link = (StgWord)*link_field;
+
+    // See Note [STATIC_LINK fields] for how the link field bits work
+    if ((((StgWord)(link)&STATIC_BITS) | prev_static_flag) != 3) {
+        StgWord new_list_head = (StgWord)q | static_flag;
+#ifndef THREADED_RTS
+        *link_field = gct->static_objects;
+        gct->static_objects = (StgClosure *)new_list_head;
+#else
+        StgWord prev;
+        prev = cas((StgVolatilePtr)link_field, link,
+                   (StgWord)gct->static_objects);
+        if (prev == link) {
+            gct->static_objects = (StgClosure *)new_list_head;
+        }
+#endif
+    }
+}
+
+/* ----------------------------------------------------------------------------
    Evacuate
 
    This is called (eventually) for every live object in the system.
@@ -392,38 +424,13 @@ loop:
 
       case THUNK_STATIC:
           if (info->srt_bitmap != 0) {
-              if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
-#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
-              }
+              evacuate_static_object(THUNK_STATIC_LINK((StgClosure *)q), q);
           }
           return;
 
       case FUN_STATIC:
-          if (info->srt_bitmap != 0 &&
-              *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
-#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
+          if (info->srt_bitmap != 0) {
+              evacuate_static_object(FUN_STATIC_LINK((StgClosure *)q), q);
           }
           return;
 
@@ -432,39 +439,11 @@ loop:
            * on the CAF list, so don't do anything with it here (we'll
            * scavenge it later).
            */
-          if (*IND_STATIC_LINK((StgClosure *)q) == NULL) {
-#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
-          }
+          evacuate_static_object(IND_STATIC_LINK((StgClosure *)q), q);
           return;
 
       case CONSTR_STATIC:
-          if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
-#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. */
+          evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
           return;
 
       case CONSTR_NOCAF_STATIC:
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 52d7f98fa0..e6a23395eb 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -134,6 +134,9 @@ long copied;        // *words* copied & scavenged during this GC
 
 rtsBool work_stealing;
 
+nat static_flag = STATIC_FLAG_B;
+nat prev_static_flag = STATIC_FLAG_A;
+
 DECLARE_GCT
 
 /* -----------------------------------------------------------------------------
@@ -141,7 +144,6 @@ DECLARE_GCT
    -------------------------------------------------------------------------- */
 
 static void mark_root               (void *user, StgClosure **root);
-static void zero_static_object_list (StgClosure* first_static);
 static void prepare_collected_gen   (generation *gen);
 static void prepare_uncollected_gen (generation *gen);
 static void init_gc_thread          (gc_thread *t);
@@ -246,6 +248,12 @@ GarbageCollect (nat collect_gen,
   N = collect_gen;
   major_gc = (N == RtsFlags.GcFlags.generations-1);
 
+  if (major_gc) {
+      prev_static_flag = static_flag;
+      static_flag =
+          static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A;
+  }
+
 #if defined(THREADED_RTS)
   work_stealing = RtsFlags.ParFlags.parGcLoadBalancingEnabled &&
                   N >= RtsFlags.ParFlags.parGcLoadBalancingGen;
@@ -672,20 +680,6 @@ GarbageCollect (nat collect_gen,
   resetStaticObjectForRetainerProfiling(gct->scavenged_static_objects);
 #endif
 
-  // zero the scavenged static object list
-  if (major_gc) {
-      nat i;
-      if (n_gc_threads == 1) {
-          zero_static_object_list(gct->scavenged_static_objects);
-      } else {
-          for (i = 0; i < n_gc_threads; i++) {
-              if (!gc_threads[i]->idle) {
-                  zero_static_object_list(gc_threads[i]->scavenged_static_objects);
-              }
-          }
-      }
-  }
-
   // Start any pending finalizers.  Must be after
   // updateStableTables() and stableUnlock() (see #4221).
   RELEASE_SM_LOCK;
@@ -1427,8 +1421,8 @@ collect_pinned_object_blocks (void)
 static void
 init_gc_thread (gc_thread *t)
 {
-    t->static_objects = END_OF_STATIC_LIST;
-    t->scavenged_static_objects = END_OF_STATIC_LIST;
+    t->static_objects = END_OF_STATIC_OBJECT_LIST;
+    t->scavenged_static_objects = END_OF_STATIC_OBJECT_LIST;
     t->scan_bd = NULL;
     t->mut_lists = t->cap->mut_lists;
     t->evac_gen_no = 0;
@@ -1465,24 +1459,6 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root)
     SET_GCT(saved_gct);
 }
 
-/* -----------------------------------------------------------------------------
-   Initialising the static object & mutable lists
-   -------------------------------------------------------------------------- */
-
-static void
-zero_static_object_list(StgClosure* first_static)
-{
-  StgClosure* p;
-  StgClosure* link;
-  const StgInfoTable *info;
-
-  for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
-    info = get_itbl(p);
-    link = *STATIC_LINK(info, p);
-    *STATIC_LINK(info,p) = NULL;
-  }
-}
-
 /* ----------------------------------------------------------------------------
    Reset the sizes of the older generations when we do a major
    collection.
@@ -1728,7 +1704,7 @@ static void gcCAFs(void)
     p = debug_caf_list;
     prev = NULL;
 
-    for (p = debug_caf_list; p != (StgIndStatic*)END_OF_STATIC_LIST;
+    for (p = debug_caf_list; p != (StgIndStatic*)END_OF_CAF_LIST;
          p = (StgIndStatic*)p->saved_info) {
 
         info = get_itbl((StgClosure*)p);
diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c
index 13316e4d29..d3cbdaefb4 100644
--- a/rts/sm/GCAux.c
+++ b/rts/sm/GCAux.c
@@ -118,14 +118,14 @@ revertCAFs( void )
     StgIndStatic *c;
 
     for (c = revertible_caf_list;
-         c != (StgIndStatic *)END_OF_STATIC_LIST;
+         c != (StgIndStatic *)END_OF_CAF_LIST;
          c = (StgIndStatic *)c->static_link)
     {
         SET_INFO((StgClosure *)c, c->saved_info);
         c->saved_info = NULL;
         // could, but not necessary: c->static_link = NULL;
     }
-    revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
+    revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
 }
 
 void
@@ -134,15 +134,17 @@ markCAFs (evac_fn evac, void *user)
     StgIndStatic *c;
 
     for (c = dyn_caf_list;
-         c != (StgIndStatic*)END_OF_STATIC_LIST;
+         c != (StgIndStatic*)END_OF_CAF_LIST;
          c = (StgIndStatic *)c->static_link)
     {
+        c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
         evac(user, &c->indirectee);
     }
     for (c = revertible_caf_list;
-         c != (StgIndStatic*)END_OF_STATIC_LIST;
+         c != (StgIndStatic*)END_OF_CAF_LIST;
          c = (StgIndStatic *)c->static_link)
     {
+        c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
         evac(user, &c->indirectee);
     }
 }
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index cbe4346afe..d42b89f973 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -131,8 +131,11 @@ typedef struct gc_thread_ {
                                    //  during GC without accessing the block
                                    //   allocators spin lock. 
 
-    StgClosure* static_objects;      // live static objects
-    StgClosure* scavenged_static_objects;   // static objects scavenged so far
+    // These two lists are chained through the STATIC_LINK() fields of static
+    // objects.  Pointers are tagged with the current static_flag, so before
+    // following a pointer, untag it with UNTAG_STATIC_LIST_PTR().
+    StgClosure* static_objects;            // live static objects
+    StgClosure* scavenged_static_objects;  // static objects scavenged so far
 
     W_ gc_count;                 // number of GCs this thread has done
 
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index c4a699e59a..e7a8401145 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -637,7 +637,8 @@ checkStaticObjects ( StgClosure* static_objects )
   StgClosure *p = static_objects;
   StgInfoTable *info;
 
-  while (p != END_OF_STATIC_LIST) {
+  while (p != END_OF_STATIC_OBJECT_LIST) {
+    p = UNTAG_STATIC_LIST_PTR(p);
     checkClosure(p);
     info = get_itbl(p);
     switch (info->type) {
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index a8f0ab037f..dfad0bef58 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -1672,7 +1672,7 @@ scavenge_capability_mut_lists (Capability *cap)
 static void
 scavenge_static(void)
 {
-  StgClosure* p;
+  StgClosure *flagged_p, *p;
   const StgInfoTable *info;
 
   debugTrace(DEBUG_gc, "scavenging static objects");
@@ -1690,10 +1690,11 @@ scavenge_static(void)
      * be more stuff on this list after each evacuation...
      * (static_objects is a global)
      */
-    p = gct->static_objects;
-    if (p == END_OF_STATIC_LIST) {
+    flagged_p = gct->static_objects;
+    if (flagged_p == END_OF_STATIC_OBJECT_LIST) {
           break;
     }
+    p = UNTAG_STATIC_LIST_PTR(flagged_p);
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl(p);
@@ -1708,7 +1709,7 @@ scavenge_static(void)
      */
     gct->static_objects = *STATIC_LINK(info,p);
     *STATIC_LINK(info,p) = gct->scavenged_static_objects;
-    gct->scavenged_static_objects = p;
+    gct->scavenged_static_objects = flagged_p;
 
     switch (info -> type) {
 
@@ -2066,7 +2067,7 @@ loop:
     work_to_do = rtsFalse;
 
     // scavenge static objects
-    if (major_gc && gct->static_objects != END_OF_STATIC_LIST) {
+    if (major_gc && gct->static_objects != END_OF_STATIC_OBJECT_LIST) {
         IF_DEBUG(sanity, checkStaticObjects(gct->static_objects));
         scavenge_static();
     }
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 6e9b0634b7..65f5b70c21 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -175,9 +175,9 @@ initStorage (void)
 
   generations[0].max_blocks = 0;
 
-  dyn_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
-  debug_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
-  revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
+  dyn_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
+  debug_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
+  revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
    
   /* initialise the allocate() interface */
   large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
@@ -427,7 +427,7 @@ newCAF(StgRegTable *reg, StgIndStatic *caf)
 
         ACQUIRE_SM_LOCK; // dyn_caf_list is global, locked by sm_mutex
         caf->static_link = (StgClosure*)dyn_caf_list;
-        dyn_caf_list = caf;
+        dyn_caf_list = (StgIndStatic*)((StgWord)caf | STATIC_FLAG_LIST);
         RELEASE_SM_LOCK;
     }
     else
@@ -484,7 +484,7 @@ StgInd* newRetainedCAF (StgRegTable *reg, StgIndStatic *caf)
     ACQUIRE_SM_LOCK;
 
     caf->static_link = (StgClosure*)revertible_caf_list;
-    revertible_caf_list = caf;
+    revertible_caf_list = (StgIndStatic*)((StgWord)caf | STATIC_FLAG_LIST);
 
     RELEASE_SM_LOCK;
 
diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h
index a4421db3f2..d0094b60fb 100644
--- a/rts/sm/Storage.h
+++ b/rts/sm/Storage.h
@@ -133,12 +133,59 @@ W_    calcLiveWords  (void);
 
 extern bdescr *exec_block;
 
-#define END_OF_STATIC_LIST ((StgClosure*)1)
-
 void move_STACK  (StgStack *src, StgStack *dest);
 
 /* -----------------------------------------------------------------------------
-   CAF lists
+   Note [STATIC_LINK fields]
+
+   The low 2 bits of the static link field have the following meaning:
+
+   00     we haven't seen this static object before
+
+   01/10  if it equals static_flag, then we saw it in this GC, otherwise
+          we saw it in the previous GC.
+
+   11     ignore during GC.  This value is used in two ways
+          - When we put CAFs on a list (see Note [CAF lists])
+          - a static constructor that was determined to have no CAF
+            references at compile time is given this value, so we
+            don't traverse it during GC
+
+  This choice of values is quite deliberate, because it means we can
+  decide whether a static object should be traversed during GC using a
+  single test:
+
+  bits = link_field & 3;
+  if ((bits | prev_static_flag) != 3) { ... }
+
+  -------------------------------------------------------------------------- */
+
+#define STATIC_BITS 3
+
+#define STATIC_FLAG_A 1
+#define STATIC_FLAG_B 2
+#define STATIC_FLAG_LIST 3
+
+#define END_OF_CAF_LIST ((StgClosure*)STATIC_FLAG_LIST)
+
+// The previous and current values of the static flag.  These flip
+// between STATIC_FLAG_A and STATIC_FLAG_B at each major GC.
+extern nat prev_static_flag, static_flag;
+
+// In the chain of static objects built up during GC, all the link
+// fields are tagged with the current static_flag value.  How to mark
+// the end of the chain?  It must be a special value so that we can
+// tell it is the end of the chain, but note that we're going to store
+// this value in the link field of a static object, which means that
+// during the NEXT GC we should treat it like any other object that
+// has not been visited during this GC.  Therefore, we use static_flag
+// as the sentinel value.
+#define END_OF_STATIC_OBJECT_LIST ((StgClosure*)(StgWord)static_flag)
+
+#define UNTAG_STATIC_LIST_PTR(p) ((StgClosure*)((StgWord)(p) & ~STATIC_BITS))
+
+/* -----------------------------------------------------------------------------
+   Note [CAF lists]
 
    dyn_caf_list  (CAFs chained through static_link)
       This is a chain of all CAFs in the program, used for
@@ -154,6 +201,10 @@ void move_STACK  (StgStack *src, StgStack *dest);
       A chain of CAFs in object code loaded with the RTS linker.
       These CAFs can be reverted to their unevaluated state using
       revertCAFs.
+
+ Pointers in these lists are tagged with STATIC_FLAG_LIST, so when
+ traversing the list remember to untag each pointer with
+ UNTAG_STATIC_LIST_PTR().
  --------------------------------------------------------------------------- */
 
 extern StgIndStatic * dyn_caf_list;