Handle promotion failures when scavenging a WEAK (#11108)

Previously, we ignored promotion failures when evacuating fields of
a WEAK object. When a failure happens, this resulted in an WEAK object
pointing to another object in a younger generation, causing crashes.

I used the test case from #11746 to check that the fix is working.
However I haven't managed to produce a test case that quickly reproduces
the issue.

Test Plan: ./validate

Reviewers: austin, bgamari, simonmar

Reviewed By: simonmar

Subscribers: thomie

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

GHC Trac Issues: #11108

3 files changed, 42 insertions, 3 deletions

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index c6ab5b161c..2393536a74 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -25,6 +25,8 @@
 #include "Storage.h"
 #include "Threads.h"
 
+#include "sm/GCUtils.h"
+#include "sm/MarkWeak.h"
 #include "sm/Sanity.h"
 
 /* -----------------------------------------------------------------------------
@@ -265,10 +267,25 @@ static rtsBool tidyWeakList(generation *gen)
 
                 new_gen = Bdescr((P_)w)->gen;
                 gct->evac_gen_no = new_gen->no;
+                gct->failed_to_evac = rtsFalse;
 
                 // evacuate the value and finalizer
-                evacuate(&w->value);
-                evacuate(&w->finalizer);
+                //
+                // This WEAK object will not be considered by tidyWeakList
+                // during this collection because it is in a generation >= N,
+                // but it is on the mutable list so we must evacuate all of its
+                // pointers because some of them may point into a younger
+                // generation.
+                scavengeLiveWeak(w);
+
+                if (gct->failed_to_evac) {
+                    debugTrace(DEBUG_weak,
+                               "putting weak pointer %p into mutable list",
+                               w);
+                    gct->failed_to_evac = rtsFalse;
+                    recordMutableGen_GC((StgClosure *)w, new_gen->no);
+                }
+
                 // remove this weak ptr from the old_weak_ptr list
                 *last_w = w->link;
                 next_w  = w->link;
@@ -418,3 +435,19 @@ markWeakPtrList ( void )
     }
 }
 
+/* -----------------------------------------------------------------------------
+   Fully scavenge a known-to-be-alive weak pointer.
+
+   In scavenge_block, we only partially scavenge a weak pointer because it may
+   turn out to be dead. This function should be called when we decide that the
+   weak pointer is alive after this GC.
+   -------------------------------------------------------------------------- */
+
+void
+scavengeLiveWeak(StgWeak *w)
+{
+    evacuate(&w->value);
+    evacuate(&w->key);
+    evacuate(&w->finalizer);
+    evacuate(&w->cfinalizers);
+}
diff --git a/rts/sm/MarkWeak.h b/rts/sm/MarkWeak.h
index bd0231d74c..aabb954496 100644
--- a/rts/sm/MarkWeak.h
+++ b/rts/sm/MarkWeak.h
@@ -24,6 +24,7 @@ void    collectFreshWeakPtrs   ( void );
 void    initWeakForGC          ( void );
 rtsBool traverseWeakPtrList    ( void );
 void    markWeakPtrList        ( void );
+void    scavengeLiveWeak       ( StgWeak * );
 
 #include "EndPrivate.h"
 
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 2fbb8f06cc..b046f39ad5 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -28,6 +28,8 @@
 #include "Capability.h"
 #include "LdvProfile.h"
 
+#include "sm/MarkWeak.h"
+
 static void scavenge_stack (StgPtr p, StgPtr stack_end);
 
 static void scavenge_large_bitmap (StgPtr p,
@@ -1286,7 +1288,6 @@ scavenge_one(StgPtr p)
     case CONSTR_1_1:
     case CONSTR_0_2:
     case CONSTR_2_0:
-    case WEAK:
     case PRIM:
     {
         StgPtr q, end;
@@ -1298,6 +1299,10 @@ scavenge_one(StgPtr p)
         break;
     }
 
+    case WEAK:
+        scavengeLiveWeak((StgWeak *)p);
+        break;
+
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY: {
         StgPtr q = p;