[commit: ghc] ghc-8.0: Handle promotion failures when scavenging a WEAK (#11108) (0e12124)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/0e12124320f0e09a56813fe6361e61043667db53/ghc

>---------------------------------------------------------------

commit 0e12124320f0e09a56813fe6361e61043667db53
Author: Takano Akio <tak at anoak.io>
Date:   Wed May 11 14:45:29 2016 +0200

    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
    
    (cherry picked from commit 9363f04d0ff22f3d898af35bb5432c4287e6dc9a)


>---------------------------------------------------------------

0e12124320f0e09a56813fe6361e61043667db53
 rts/sm/MarkWeak.c | 37 +++++++++++++++++++++++++++++++++++--
 rts/sm/MarkWeak.h |  1 +
 rts/sm/Scav.c     |  7 ++++++-
 3 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 9a32198..bb6309d 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;
@@ -422,3 +439,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 bd0231d..aabb954 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 a28d842..de098d2 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,
@@ -1293,7 +1295,6 @@ scavenge_one(StgPtr p)
     case CONSTR_1_1:
     case CONSTR_0_2:
     case CONSTR_2_0:
-    case WEAK:
     case PRIM:
     case IND_PERM:
     {
@@ -1306,6 +1307,10 @@ scavenge_one(StgPtr p)
         break;
     }
 
+    case WEAK:
+        scavengeLiveWeak((StgWeak *)p);
+        break;
+
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY: {
         StgPtr q = p;