X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=3212ce5852737cbf8e5703630294786c8ac86a14;hb=8c84944d5782f2ee60d96c02977f15ba9e7ab935;hp=c40d18b29549a96118fa2e2400b7c2db3725ef13;hpb=e9655493989157820d8a0a7b0f7c311c159ef956;p=ghc-hetmet.git

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index c40d18b..3212ce5 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -20,12 +20,13 @@
 #include "GCThread.h"
 #include "GCUtils.h"
 #include "Compact.h"
+#include "MarkStack.h"
 #include "Prelude.h"
 #include "Trace.h"
 #include "LdvProfile.h"
 
 #if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC)
-StgWord64 evac_collision = 0;
+StgWord64 whitehole_spin = 0;
 #endif
 
 #if defined(THREADED_RTS) && !defined(PARALLEL_GC)
@@ -97,8 +98,6 @@ copy_tag(StgClosure **p, const StgInfoTable *info,
 
     to = alloc_for_copy(size,stp);
     
-    TICK_GC_WORDS_COPIED(size);
-
     from = (StgPtr)src;
     to[0] = (W_)info;
     for (i = 1; i < size; i++) { // unroll for small i
@@ -112,13 +111,9 @@ copy_tag(StgClosure **p, const StgInfoTable *info,
 #if defined(PARALLEL_GC)
     {
         const StgInfoTable *new_info;
-        new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info,
-                                             (W_)info, MK_FORWARDING_PTR(to));
+        new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to));
         if (new_info != info) {
-#if defined(PROF_SPIN)
-            evac_collision++;
-#endif
-            evacuate(p); // does the failed_to_evac stuff
+            return evacuate(p); // does the failed_to_evac stuff
         } else {
             *p = TAG_CLOSURE(tag,(StgClosure*)to);
         }
@@ -147,8 +142,6 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
     *p = TAG_CLOSURE(tag,(StgClosure*)to);
     src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
     
-    TICK_GC_WORDS_COPIED(size);
-
     from = (StgPtr)src;
     to[0] = (W_)info;
     for (i = 1; i < size; i++) { // unroll for small i
@@ -172,42 +165,44 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
  * used to optimise evacuation of BLACKHOLEs.
  */
 static rtsBool
-copyPart(StgClosure **p, const StgInfoTable *info, StgClosure *src, 
-         nat size_to_reserve, nat size_to_copy, step *stp)
+copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
 {
     StgPtr to, from;
     nat i;
+    StgWord info;
     
-    to = alloc_for_copy(size_to_reserve, stp);
+#if defined(PARALLEL_GC)
+spin:
+	info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
+	if (info == (W_)&stg_WHITEHOLE_info) {
+#ifdef PROF_SPIN
+	    whitehole_spin++;
+#endif
+	    goto spin;
+	}
+    if (IS_FORWARDING_PTR(info)) {
+	src->header.info = (const StgInfoTable *)info;
+	evacuate(p); // does the failed_to_evac stuff
+	return rtsFalse;
+    }
+#else
+    info = (W_)src->header.info;
+#endif
 
-    TICK_GC_WORDS_COPIED(size_to_copy);
+    to = alloc_for_copy(size_to_reserve, stp);
+    *p = (StgClosure *)to;
 
     from = (StgPtr)src;
-    to[0] = (W_)info;
+    to[0] = info;
     for (i = 1; i < size_to_copy; i++) { // unroll for small i
 	to[i] = from[i];
     }
     
 #if defined(PARALLEL_GC)
-    {
-        const StgInfoTable *new_info;
-        new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, 
-                                             (W_)info, MK_FORWARDING_PTR(to));
-        if (new_info != info) {
-#if defined(PROF_SPIN)
-            evac_collision++;
-#endif
-            evacuate(p); // does the failed_to_evac stuff
-            return rtsFalse;
-        } else {
-            *p = (StgClosure*)to;
-        }
-    }
-#else
-    src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
-    *p = (StgClosure*)to;
+    write_barrier();
 #endif
-
+    src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to);
+    
 #ifdef PROFILING
     // We store the size of the just evacuated object in the LDV word so that
     // the profiler can guess the position of the next object later.
@@ -505,11 +500,6 @@ loop:
        */
       if (!is_marked((P_)q,bd)) {
           mark((P_)q,bd);
-          if (mark_stack_full()) {
-              debugTrace(DEBUG_gc,"mark stack overflowed");
-              mark_stack_overflowed = rtsTrue;
-              reset_mark_stack();
-          }
           push_mark_stack((P_)q);
       }
       return;
@@ -559,8 +549,17 @@ loop:
       copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp);
       return;
 
+  // For ints and chars of low value, save space by replacing references to
+  //	these with closures with references to common, shared ones in the RTS.
+  //
+  // * Except when compiling into Windows DLLs which don't support cross-package
+  //	data references very well.
+  //
   case CONSTR_0_1:
-  { 
+  {   
+#if defined(__PIC__) && defined(mingw32_HOST_OS) 
+      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
+#else
       StgWord w = (StgWord)q->payload[0];
       if (info == Czh_con_info &&
 	  // unsigned, so always true:  (StgChar)w >= MIN_CHARLIKE &&  
@@ -578,6 +577,7 @@ loop:
       else {
           copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
       }
+#endif
       return;
   }
 
@@ -639,7 +639,7 @@ loop:
 
   case CAF_BLACKHOLE:
   case BLACKHOLE:
-      copyPart(p,info,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
+      copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
       return;
 
   case THUNK_SELECTOR:
@@ -703,15 +703,14 @@ loop:
 	goto loop;
       }
 
-      /* To evacuate a small TSO, we need to relocate the update frame
-       * list it contains.  
+      /* To evacuate a small TSO, we need to adjust the stack pointer
        */
       {
 	  StgTSO *new_tso;
 	  StgPtr r, s;
           rtsBool mine;
 
-	  mine = copyPart(p,info,(StgClosure *)tso, tso_sizeW(tso), 
+	  mine = copyPart(p,(StgClosure *)tso, tso_sizeW(tso), 
                           sizeofW(StgTSO), stp);
           if (mine) {
               new_tso = (StgTSO *)*p;