X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=1c0a2d803b180f5454cb70e50b700dd5abd8e64e;hb=ebaff0a85ffb62f7875473dc65eeeb7c62800981;hp=35939430a2c5a15f7edf6221e1c29b994cf7b5c2;hpb=797dca87dcc96224ee7e96e852c4381266533597;p=ghc-hetmet.git

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 3593943..1c0a2d8 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -169,6 +169,9 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val)
 #else
         ASSERT(p->header.info == &stg_BLACKHOLE_info);
 #endif
+        // val must be in to-space.
+        ASSERT(Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED));
+
         prev = (StgSelector*)((StgClosure *)p)->payload[0];
 
         // Update the THUNK_SELECTOR with an indirection to the
@@ -177,8 +180,9 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val)
         // EVACUATED closure always points to an object in the
         // same or an older generation (required by the short-cut
         // test in the EVACUATED case, below).
-        SET_INFO(p, &stg_IND_info);
         ((StgInd *)p)->indirectee = val;
+        write_barrier();
+        SET_INFO(p, &stg_IND_info);
 
         // For the purposes of LDV profiling, we have created an
         // indirection.
@@ -243,16 +247,26 @@ selector_chain:
     // In threaded mode, we'll use WHITEHOLE to lock the selector
     // thunk while we evaluate it.
     {
-	info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
-	if (info_ptr == (W_)&stg_WHITEHOLE_info) {
-            do {
-                info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
-            } while (info_ptr == (W_)&stg_WHITEHOLE_info);
-            goto bale_out;
-	}
-        // make sure someone else didn't get here first
+        do {
+            info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
+        } while (info_ptr == (W_)&stg_WHITEHOLE_info);
+
+        // make sure someone else didn't get here first...
         if (INFO_PTR_TO_STRUCT(info_ptr)->type != THUNK_SELECTOR) {
-            goto bale_out;
+            // v. tricky now.  The THUNK_SELECTOR has been evacuated
+            // by another thread, and is now either EVACUATED or IND.
+            // We need to extract ourselves from the current situation
+            // as cleanly as possible.
+            //   - unlock the closure
+            //   - update *q, we may have done *some* evaluation
+            //   - if evac, we need to call evacuate(), because we
+            //     need the write-barrier stuff.
+            //   - undo the chain we've built to point to p.
+            SET_INFO(p, (const StgInfoTable *)info_ptr);
+            *q = (StgClosure *)p;
+            if (evac) evacuate(q);
+            unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p);
+            return;
         }
     }
 #else
@@ -404,6 +418,9 @@ bale_out:
     // We didn't manage to evaluate this thunk; restore the old info
     // pointer.  But don't forget: we still need to evacuate the thunk itself.
     SET_INFO(p, (const StgInfoTable *)info_ptr);
+    // THREADED_RTS: we just unlocked the thunk, so another thread
+    // might get in and update it.  copy() will lock it again and
+    // check whether it was updated in the meantime.
     *q = (StgClosure *)p;
     if (evac) {
         copy(q,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->step->to);