diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2017-07-03 16:54:00 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-07-03 18:58:11 -0400 |
| commit | f9c6d53fe997f1c560cda6f346f4b201711df37c (patch) | |
| tree | 91e41eb282e50de75da718bb6940597d7974eeb0 /rts/Interpreter.c | |
| parent | 1a9c3c44ef82803766a8db91a619393c43195ad3 (diff) | |
| download | haskell-f9c6d53fe997f1c560cda6f346f4b201711df37c.tar.gz | |
Tag the FUN before making a PAP (#13767)
Pointers to FUNs are not guaranteed to be tagged in general, because
the compiler doesn't always know the arity of a FUN when it needs to
reference it, e.g. with -O0 when the function is in another module.
However, there's one case where we can put the correct tag on a FUN:
when it is referenced by a PAP, because when building the PAP we know
the arity and we can tag the pointer correctly. The AutoApply code
does this, and the sanity checker checks it, but the interpreter did
not respect this invariant. This patch fixes it.
Test Plan:
```
(cd ghc && make 2 GhcDebugged=YES)
./inplace/bin/ghc-stage2 --interpreter +RTS -DS
```
Reviewers: niteria, bgamari, austin, erikd
Reviewed By: bgamari
Subscribers: rwbarton, thomie
GHC Trac Issues: #13767
Differential Revision: https://phabricator.haskell.org/D3680
Diffstat (limited to 'rts/Interpreter.c')
| -rw-r--r-- | rts/Interpreter.c | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/rts/Interpreter.c b/rts/Interpreter.c index 92914735a7..a2f0b5898e 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -406,8 +406,18 @@ eval_obj: case FUN_STATIC: #if defined(PROFILING) if (cap->r.rCCCS != obj->header.prof.ccs) { + int arity = get_fun_itbl(obj)->f.arity; + // Tag the function correctly. We guarantee that pap->fun + // is correctly tagged (this is checked by + // Sanity.c:checkPAP()), but we don't guarantee that every + // pointer to a FUN is tagged on the stack or elsewhere, + // so we fix the tag here. (#13767) + // For full details of the invariants on tagging, see + // https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/HaskellExecution/PointerTagging tagged_obj = - newEmptyPAP(cap, tagged_obj, get_fun_itbl(obj)->f.arity); + newEmptyPAP(cap, + arity <= TAG_MASK ? obj + arity : obj, + arity); } #endif break; @@ -424,7 +434,7 @@ eval_obj: ASSERT(((StgBCO *)obj)->arity > 0); #if defined(PROFILING) if (cap->r.rCCCS != obj->header.prof.ccs) { - tagged_obj = newEmptyPAP(cap, tagged_obj, ((StgBCO *)obj)->arity); + tagged_obj = newEmptyPAP(cap, obj, ((StgBCO *)obj)->arity); } #endif break; |