diff options
author | Simon Marlow <marlowsd@gmail.com> | 2013-02-14 13:10:29 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2013-02-14 13:11:00 +0000 |
commit | 3c1fd687625d4ce026a327c7d2388661628f7c63 (patch) | |
tree | d314c77bd1e940f5eb48c90280c0cf4c361c24fe /rts/Stable.c | |
parent | 9b6e931574992913fbb6a5e537abdb088c3da4f2 (diff) | |
download | haskell-3c1fd687625d4ce026a327c7d2388661628f7c63.tar.gz |
removeIndirections: look through BLACKHOLE indirections
This has been breaking StableNames for quite a while.
Diffstat (limited to 'rts/Stable.c')
-rw-r--r-- | rts/Stable.c | 46 |
1 files changed, 27 insertions, 19 deletions
diff --git a/rts/Stable.c b/rts/Stable.c index e1807faa72..0dade10105 100644 --- a/rts/Stable.c +++ b/rts/Stable.c @@ -278,28 +278,36 @@ freeStablePtr(StgStablePtr sp) /* * get at the real stuff...remove indirections. - * It untags pointers before dereferencing and - * retags the real stuff with its tag (if there - * is any) when returning. - * - * ToDo: move to a better home. */ -static -StgClosure* -removeIndirections(StgClosure* p) +static StgClosure* +removeIndirections (StgClosure* p) { - StgWord tag = GET_CLOSURE_TAG(p); - StgClosure* q = UNTAG_CLOSURE(p); - - while (get_itbl(q)->type == IND || - get_itbl(q)->type == IND_STATIC || - get_itbl(q)->type == IND_PERM) { - q = ((StgInd *)q)->indirectee; - tag = GET_CLOSURE_TAG(q); - q = UNTAG_CLOSURE(q); - } + StgClosure* q; + + while (1) + { + q = UNTAG_CLOSURE(p); + + switch (get_itbl(q)->type) { + case IND: + case IND_STATIC: + case IND_PERM: + p = ((StgInd *)q)->indirectee; + continue; + + case BLACKHOLE: + p = ((StgInd *)q)->indirectee; + if (GET_CLOSURE_TAG(p) != 0) { + continue; + } else { + break; + } - return TAG_CLOSURE(tag,q); + default: + break; + } + return p; + } } StgWord |