[commit: ghc] ghc-8.2: Fix bug in previous fix for #5654 (fd26938)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/fd269386b096d59a849853952cef213f805d24b3/ghc

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

commit fd269386b096d59a849853952cef213f805d24b3
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Sat Dec 17 18:08:48 2016 -0500

    Fix bug in previous fix for #5654
    
    I forgot to account for BCOs, which have a different layout from
    functions.  This caused crashes when using profiling with GHCi (via
    -fexternal-interpreter -prof), which unfortunately is not tested at all
    by validate, even when profiling is enabled.  I'm going to add some
    testing that would have caught this in a separate patch.
    
    Test Plan:
    ```
    cd nofib/spectral/puzzle && make NoFibWithGHCi=YES
    EXTRA_RUNTEST_OPTS='-fexternal-interpreter -prof'
    ```
    New testsuite tests coming in a separate diff.
    
    Reviewers: niteria, austin, erikd, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2868
    
    GHC Trac Issues: #5654
    
    (cherry picked from commit 2a02040b2e23daa4f791afc290c33c9bbe3c620c)


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

fd269386b096d59a849853952cef213f805d24b3
 rts/Apply.cmm | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/rts/Apply.cmm b/rts/Apply.cmm
index 3a73ce0..b18c347 100644
--- a/rts/Apply.cmm
+++ b/rts/Apply.cmm
@@ -57,6 +57,7 @@ stg_ap_0_fast ( P_ fun )
 again:
     W_  info;
     W_ untaggedfun;
+    W_ arity;
     untaggedfun = UNTAG(fun);
     info = %INFO_PTR(untaggedfun);
     switch [INVALID_OBJECT .. N_CLOSURE_TYPES]
@@ -68,6 +69,11 @@ again:
             fun = StgInd_indirectee(fun);
             goto again;
         }
+        case BCO:
+        {
+            arity = TO_W_(StgBCO_arity(untaggedfun));
+            goto dofun;
+        }
         case
             FUN,
             FUN_1_0,
@@ -75,9 +81,10 @@ again:
             FUN_2_0,
             FUN_1_1,
             FUN_0_2,
-            FUN_STATIC,
-            BCO:
+            FUN_STATIC:
         {
+            arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));
+        dofun:
             if (CCCS == StgHeader_ccs(untaggedfun)) {
                 return (fun);
             } else {
@@ -92,10 +99,8 @@ again:
                 // attribute this allocation to the "overhead of profiling"
                 CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD);
                 P_ pap;
-                W_ arity;
                 pap = Hp - SIZEOF_StgPAP + WDS(1);
                 SET_HDR(pap, stg_PAP_info, CCCS);
-                arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));
                 StgPAP_arity(pap) = arity;
                 StgPAP_fun(pap)   = fun;
                 StgPAP_n_args(pap) = 0;