summaryrefslogtreecommitdiff
path: root/rts/Stable.c
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2013-02-14 13:10:29 +0000
committerSimon Marlow <marlowsd@gmail.com>2013-02-14 13:11:00 +0000
commit3c1fd687625d4ce026a327c7d2388661628f7c63 (patch)
treed314c77bd1e940f5eb48c90280c0cf4c361c24fe /rts/Stable.c
parent9b6e931574992913fbb6a5e537abdb088c3da4f2 (diff)
downloadhaskell-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.c46
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