rts/Linker.c: declare 'deRefStablePtr' as an exported 'rts' symbol
[ghc.git] / rts / Stable.c
index e1807fa..229d707 100644 (file)
@@ -83,7 +83,7 @@
 
   Future plans for stable ptrs include distinguishing them by the
   generation of the pointed object. See
-  http://hackage.haskell.org/trac/ghc/ticket/7670 for details.
+  http://ghc.haskell.org/trac/ghc/ticket/7670 for details.
 */
 
 snEntry *stable_name_table = NULL;
@@ -246,6 +246,7 @@ STATIC_INLINE void
 freeSnEntry(snEntry *sn)
 {
   ASSERT(sn->sn_obj == NULL);
+  removeHashTable(addrToStableHash, (W_)sn->old, NULL);
   sn->addr = (P_)stable_name_free;
   stable_name_free = sn;
 }
@@ -278,28 +279,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
@@ -540,3 +549,11 @@ updateStableTables(rtsBool full)
             });
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End: