diff options
| author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2018-08-21 16:06:29 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-08-21 18:56:12 -0400 |
| commit | 2693eb11f55f2001701c90c24183e21c794a8be1 (patch) | |
| tree | 4dc837aaa892c3b442c1d9693f69139989cf6387 /rts/Apply.cmm | |
| parent | 68a1fc29b4bb3eae54e4d96c9aec20e700040f34 (diff) | |
| download | haskell-2693eb11f55f2001701c90c24183e21c794a8be1.tar.gz | |
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
Diffstat (limited to 'rts/Apply.cmm')
| -rw-r--r-- | rts/Apply.cmm | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 15d8250f52..7e23609638 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); |