[commit: ghc] master: Properly tag fun field of PAPs generated by ap_0_fast (2693eb1)
git at git.haskell.org
git at git.haskell.org
Tue Aug 21 22:58:08 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/2693eb11f55f2001701c90c24183e21c794a8be1/ghc
>---------------------------------------------------------------
commit 2693eb11f55f2001701c90c24183e21c794a8be1
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date: Tue Aug 21 16:06:29 2018 -0400
Properly tag fun field of PAPs generated by ap_0_fast
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
>---------------------------------------------------------------
2693eb11f55f2001701c90c24183e21c794a8be1
rts/Apply.cmm | 14 ++++++++------
1 file changed, 8 insertions(+), 6 deletions(-)
diff --git a/rts/Apply.cmm b/rts/Apply.cmm
index 15d8250..7e23609 100644
--- a/rts/Apply.cmm
+++ b/rts/Apply.cmm
@@ -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);
More information about the ghc-commits
mailing list