[commit: ghc] master: removeIndirections: look through BLACKHOLE indirections (3c1fd68)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3c1fd687625d4ce026a327c7d2388661628f7c63

>---------------------------------------------------------------

commit 3c1fd687625d4ce026a327c7d2388661628f7c63
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Feb 14 13:10:29 2013 +0000

    removeIndirections: look through BLACKHOLE indirections
    
    This has been breaking StableNames for quite a while.

>---------------------------------------------------------------

 rts/Stable.c |   48 ++++++++++++++++++++++++++++--------------------
 1 files changed, 28 insertions(+), 20 deletions(-)

diff --git a/rts/Stable.c b/rts/Stable.c
index e1807fa..0dade10 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