don't sanity check the whole stack when switching interp<->compiled

[ghc-hetmet.git] / rts / sm / Evac.c

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 062b73f..9836e51 100644 (file)
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -11,17 +11,19 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
-#include "Storage.h"
-#include "MBlock.h"
+
 #include "Evac.h"
+#include "Storage.h"
 #include "GC.h"
 #include "GCThread.h"
 #include "GCUtils.h"
 #include "Compact.h"
+#include "MarkStack.h"
 #include "Prelude.h"
-#include "LdvProfile.h"
 #include "Trace.h"
+#include "LdvProfile.h"
 
 #if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC)
 StgWord64 whitehole_spin = 0;
@@ -74,10 +76,10 @@ alloc_for_copy (nat size, step *stp)
      * necessary.
      */
     to = ws->todo_free;
-    if (to + size > ws->todo_lim) {
+    ws->todo_free += size;
+    if (ws->todo_free > ws->todo_lim) {
        to = todo_block_full(size, ws);
     }
-    ws->todo_free = to + size;
     ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim);
 
     return to;
@@ -96,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
@@ -142,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
@@ -194,8 +192,6 @@ spin:
     to = alloc_for_copy(size_to_reserve, stp);
     *p = (StgClosure *)to;
 
-    TICK_GC_WORDS_COPIED(size_to_copy);
-
     from = (StgPtr)src;
     to[0] = info;
     for (i = 1; i < size_to_copy; i++) { // unroll for small i
@@ -286,8 +282,7 @@ evacuate_large(StgPtr p)
   ws = &gct->steps[new_stp->abs_no];
 
   bd->flags |= BF_EVACUATED;
-  bd->step = new_stp;
-  bd->gen_no = new_stp->gen_no;
+  initBdescr(bd, new_stp);
 
   // If this is a block of pinned objects, we don't have to scan
   // these objects, because they aren't allowed to contain any
@@ -295,8 +290,10 @@ evacuate_large(StgPtr p)
   // them straight on the scavenged_large_objects list.
   if (bd->flags & BF_PINNED) {
       ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS);
-      dbl_link_onto(bd, &ws->step->scavenged_large_objects);
-      ws->step->n_scavenged_large_blocks += bd->blocks;
+      if (new_stp != stp) { ACQUIRE_SPIN_LOCK(&new_stp->sync_large_objects); }
+      dbl_link_onto(bd, &new_stp->scavenged_large_objects);
+      new_stp->n_scavenged_large_blocks += bd->blocks;
+      if (new_stp != stp) { RELEASE_SPIN_LOCK(&new_stp->sync_large_objects); }
   } else {
       bd->link = ws->todo_large_objects;
       ws->todo_large_objects = bd;
@@ -502,17 +499,12 @@ 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;
   }
       
-  stp = bd->step->to;
+  stp = bd->dest;
 
   info = q->header.info;
   if (IS_FORWARDING_PTR(info))
@@ -556,8 +548,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 &&  
@@ -575,6 +576,7 @@ loop:
       else {
           copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
       }
+#endif
       return;
   }
 
@@ -700,8 +702,7 @@ 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;
@@ -1067,7 +1068,7 @@ bale_out:
     // check whether it was updated in the meantime.
     *q = (StgClosure *)p;
     if (evac) {
-        copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->step->to);
+        copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest);
     }
     unchain_thunk_selectors(prev_thunk_selector, *q);
     return;