Properly tag fun field of PAPs generated by ap_0_fast
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Tue, 21 Aug 2018 20:06:29 +0000 (16:06 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 21 Aug 2018 22:56:12 +0000 (18:56 -0400)
Currently ap_0_fast doesn't maintain the invariant for PAP fun fields
which says if the closure can be tagged, it should be. This is checked
by `Sanity.c:checkPAP` and correctly implemented by `genautoapply`.

This causes sanity check failures when we have a profiling code like

    f = {-# SCC scc #-} g

where g is a PAP or a FUN, and `scc` is different than the current cost
centre.

Test Plan: Slow validate (not done yet)

Reviewers: simonmar, bgamari, erikd

Reviewed By: simonmar

Subscribers: rwbarton, carter

GHC Trac Issues: #15508

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

rts/Apply.cmm

index 15d8250..7e23609 100644 (file)
@@ -106,6 +106,9 @@ again:
                 pap = Hp - SIZEOF_StgPAP + WDS(1);
                 SET_HDR(pap, stg_PAP_info, CCCS);
                 StgPAP_arity(pap) = arity;
+                if (arity <= TAG_MASK) {
+                  fun = untaggedfun + arity;
+                }
                 StgPAP_fun(pap)   = fun;
                 StgPAP_n_args(pap) = 0;
                 return (pap);
@@ -117,9 +120,8 @@ again:
                 return (fun);
             } else {
                 // We're going to copy this PAP, and put the new CCS in it
-                fun = untaggedfun;
                 W_ size;
-                size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(fun)));
+                size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(untaggedfun)));
                 HP_CHK_GEN(size);
                 TICK_ALLOC_PAP(size, 0);
                 // attribute this allocation to the "overhead of profiling"
@@ -127,13 +129,13 @@ again:
                 P_ pap;
                 pap = Hp - size + WDS(1);
                 // We'll lose the original PAP, so we should enter its CCS
-                ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(fun) "ptr");
+                ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr");
                 SET_HDR(pap, stg_PAP_info, CCCS);
-                StgPAP_arity(pap) = StgPAP_arity(fun);
-                StgPAP_n_args(pap) = StgPAP_n_args(fun);
+                StgPAP_arity(pap) = StgPAP_arity(untaggedfun);
+                StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun);
                 StgPAP_fun(pap)   = StgPAP_fun(fun);
                 W_ i;
-                i = TO_W_(StgPAP_n_args(fun));
+                i = TO_W_(StgPAP_n_args(untaggedfun));
             loop:
                 if (i == 0) {
                     return (pap);