[commit: ghc] ghc-8.0: Check CCS tree for pointers into shared object during checkUnload (da6d720)

[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/da6d72057e20389c621eb7dd8d7018206eda5900/ghc

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

commit da6d72057e20389c621eb7dd8d7018206eda5900
Author: Andrew Farmer <anfarmer at fb.com>
Date:   Sun Apr 17 14:43:24 2016 +0200

    Check CCS tree for pointers into shared object during checkUnload
    
    Prevent shared objects from being unloaded if cost centre stacks point
    at the object. This will prevent segfault in #11776, but also prevents
    objects from ever being unloaded when profiling. Pruning CCS tree will
    enable that in another diff.
    
    Test Plan: make TEST=linker_profiled, examine linker_profiled.run.stderr
    
    Reviewers: austin, simonmar, bgamari
    
    Reviewed By: simonmar, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2069
    
    GHC Trac Issues: #11776
    
    (cherry picked from commit 36a0b6dc27ae0ee2022afbef5d3cd49dfde9e82b)


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

da6d72057e20389c621eb7dd8d7018206eda5900
 rts/CheckUnload.c | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index c756738..8d0846c 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -23,6 +23,7 @@
 //   - info pointers in heap objects and stack frames
 //   - pointers to static objects from the heap
 //   - StablePtrs to static objects
+//   - pointers to cost centres from the cost centre tree
 //
 // We can find live static objects after a major GC, so we don't have
 // to look at every closure pointer in the heap.  However, we do have
@@ -245,6 +246,25 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
     }
 }
 
+#ifdef PROFILING
+//
+// Do not unload the object if the CCS tree refers to a CCS or CC which
+// originates in the object.
+//
+static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs)
+{
+    IndexTable *i;
+
+    checkAddress(addrs, ccs);
+    checkAddress(addrs, ccs->cc);
+    for (i = ccs->indexTable; i != NULL; i = i->next) {
+        if (!i->back_edge) {
+            searchCostCentres(addrs, i->ccs);
+        }
+    }
+}
+#endif
+
 //
 // Check whether we can unload any object code.  This is called at the
 // appropriate point during a GC, where all the heap data is nice and
@@ -304,6 +324,17 @@ void checkUnload (StgClosure *static_objects)
       }
   }
 
+#ifdef PROFILING
+  /* Traverse the cost centre tree, calling checkAddress on each CCS/CC */
+  searchCostCentres(addrs, CCS_MAIN);
+
+  /* Also check each cost centre in the CC_LIST */
+  CostCentre *cc;
+  for (cc = CC_LIST; cc != NULL; cc = cc->link) {
+      checkAddress(addrs, cc);
+  }
+#endif /* PROFILING */
+
   // Look through the unloadable objects, and any object that is still
   // marked as unreferenced can be physically unloaded, because we
   // have no references to it.