X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=1c453fc52e7763b539a66d511208fa17d3b995c5;hb=979fb4abd736734d30089a8b328824d4a5862a6a;hp=9b42fc12be993d1d3aa233d5c029af2db9602fb5;hpb=81af806b823c3dd633a7c102b1fa6afbf89f16ef;p=ghc-hetmet.git

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 9b42fc1..1c453fc 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -626,8 +626,6 @@ loop:
       return;
 
   case CAF_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case SE_BLACKHOLE:
   case BLACKHOLE:
       copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
       return;
@@ -837,6 +835,11 @@ selector_chain:
         if (bd->flags & BF_EVACUATED) {
             unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p);
             *q = (StgClosure *)p;
+            // shortcut, behave as for:  if (evac) evacuate(q);
+            if (evac && bd->step < gct->evac_step) {
+                gct->failed_to_evac = rtsTrue;
+                TICK_GC_FAILED_PROMOTION();
+            }
             return;
         }
         // we don't update THUNK_SELECTORS in the compacted
@@ -940,8 +943,12 @@ selector_loop:
               // the original selector thunk, p.
               SET_INFO(p, (StgInfoTable *)info_ptr);
               LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)p);
+#if defined(THREADED_RTS)
+              SET_INFO(p, &stg_WHITEHOLE_info);
+#else
               SET_INFO(p, &stg_BLACKHOLE_info);
 #endif
+#endif
 
               // the closure in val is now the "value" of the
               // THUNK_SELECTOR in p.  However, val may itself be a
@@ -1033,8 +1040,6 @@ selector_loop:
       case THUNK_0_2:
       case THUNK_STATIC:
       case CAF_BLACKHOLE:
-      case SE_CAF_BLACKHOLE:
-      case SE_BLACKHOLE:
       case BLACKHOLE:
 	  // not evaluated yet 
 	  goto bale_out;