[commit: ghc] ghc-8.4: rts/RetainerProfile: Handle BLOCKING_QUEUES (0ec1bd6)

[git at git.haskell.org]

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

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/0ec1bd64b3317febe8c018041f538f1c83135e6c/ghc

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

commit 0ec1bd64b3317febe8c018041f538f1c83135e6c
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Sat Apr 7 13:32:04 2018 -0400

    rts/RetainerProfile: Handle BLOCKING_QUEUES
    
    push() considers BLOCKING_QUEUES to be an invalid closure type which
    should never be present on the stack. However, retainClosure made no
    accomodation for this and ended up pushing such a closure. This lead
    to #14947.
    
    Test Plan: Validate
    
    Reviewers: simonmar, erikd
    
    Reviewed By: simonmar
    
    Subscribers: thomie, carter, RyanGlScott
    
    GHC Trac Issues: #14947
    
    Differential Revision: https://phabricator.haskell.org/D4538
    
    (cherry picked from commit d5f6d7a03d66a93ec05a90948126feffc9279dc6)


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

0ec1bd64b3317febe8c018041f538f1c83135e6c
 rts/RetainerProfile.c | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 7a9b9cc..67cba83 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -426,7 +426,7 @@ find_srt( stackPos *info )
  *  push() pushes a stackElement representing the next child of *c
  *  onto the traverse stack. If *c has no child, *first_child is set
  *  to NULL and nothing is pushed onto the stack. If *c has only one
- *  child, *c_chlid is set to that child and nothing is pushed onto
+ *  child, *c_child is set to that child and nothing is pushed onto
  *  the stack.  If *c has more than two children, *first_child is set
  *  to the first child and a stackElement representing the second
  *  child is pushed onto the stack.
@@ -1706,6 +1706,15 @@ inner_loop:
         goto loop;
     }
 
+    case BLOCKING_QUEUE:
+    {
+        StgBlockingQueue *bq = (StgBlockingQueue *)c;
+        retainClosure((StgClosure*) bq->link,           c, c_child_r);
+        retainClosure((StgClosure*) bq->bh,             c, c_child_r);
+        retainClosure((StgClosure*) bq->owner,          c, c_child_r);
+        goto loop;
+    }
+
     case PAP:
     {
         StgPAP *pap = (StgPAP *)c;