X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=295a0305aca94244a295a294a70d14e1d40acc5d;hb=d07d5ed880e6f4529c2331a5d5a963505d884dd9;hp=e8f85b6963f18e97b493684db5af80501cf85d9a;hpb=d13df738cbbe8017ae19ae2702f4e10805ee521b;p=ghc-hetmet.git

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index e8f85b6..295a030 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -37,7 +37,6 @@ alloc_for_copy (nat size, step *stp)
 {
     StgPtr to;
     step_workspace *ws;
-    bdescr *bd;
 
     /* Find out where we're going, using the handy "to" pointer in 
      * the step of the source object.  If it turns out we need to
@@ -57,127 +56,16 @@ alloc_for_copy (nat size, step *stp)
     /* chain a new block onto the to-space for the destination step if
      * necessary.
      */
-    bd = ws->todo_bd;
-    to = bd->free;
-    if (to + size >= bd->start + BLOCK_SIZE_W) {
-	bd = gc_alloc_todo_block(ws);
-	to = bd->free;
-    }
-    bd->free = to + size;
-
-    return to;
-}
-  
-STATIC_INLINE void
-copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp,StgWord tag)
-{
-    StgPtr to, tagged_to, from;
-    nat i;
-    StgWord info;
-
-#ifdef THREADED_RTS
-    do {
-	info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
-	// so..  what is it?
-    } while (info == (W_)&stg_WHITEHOLE_info);
-    if (info == (W_)&stg_EVACUATED_info) {
-	src->header.info = (const StgInfoTable *)info;
-	return evacuate(p); // does the failed_to_evac stuff
-    }
-#else
-    info = (W_)src->header.info;
-    src->header.info = &stg_EVACUATED_info;
-#endif
-
-    to = alloc_for_copy(size,stp);
-    tagged_to = (StgPtr)TAG_CLOSURE(tag,(StgClosure*)to);
-    *p = (StgClosure *)tagged_to;
-    
-    TICK_GC_WORDS_COPIED(size);
-
-    from = (StgPtr)src;
-    to[0] = info;
-    for (i = 1; i < size; i++) { // unroll for small i
-	to[i] = from[i];
-    }
-    
-    ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to;
-
-    // retag pointer before updating EVACUATE closure and returning
-
-//  if (to+size+2 < bd->start + BLOCK_SIZE_W) {
-//      __builtin_prefetch(to + size + 2, 1);
-//  }
-
-#ifdef THREADED_RTS
-    write_barrier();
-    ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
-#endif
-
-#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.
-    SET_EVACUAEE_FOR_LDV(from, size);
-#endif
-}
-  
-/* Special version of copy() for when we only want to copy the info
- * pointer of an object, but reserve some padding after it.  This is
- * used to optimise evacuation of BLACKHOLEs.
- */
-static void
-copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
-{
-    StgPtr to, from;
-    nat i;
-    StgWord info;
     
-#ifdef THREADED_RTS
-    do {
-	info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
-    } while (info == (W_)&stg_WHITEHOLE_info);
-    if (info == (W_)&stg_EVACUATED_info) {
-	src->header.info = (const StgInfoTable *)info;
-	return evacuate(p); // does the failed_to_evac stuff
+    ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim);
+    to = ws->todo_free;
+    if (to + size >= ws->todo_lim) {
+	to = gc_alloc_todo_block(ws);
     }
-#else
-    info = (W_)src->header.info;
-    src->header.info = &stg_EVACUATED_info;
-#endif
-
-    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
-	to[i] = from[i];
-    }
-    
-    ((StgEvacuated*)from)->evacuee = (StgClosure *)to;
-#ifdef THREADED_RTS
-    write_barrier();
-    ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
-#endif
-    
-#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.
-    SET_EVACUAEE_FOR_LDV(from, size_to_reserve);
-    // fill the slop
-    if (size_to_reserve - size_to_copy > 0)
-	LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy)); 
-#endif
-}
-
+    ws->todo_free = to + size;
+    ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim);
 
-/* Copy wrappers that don't tag the closure after copying */
-STATIC_INLINE void
-copy(StgClosure **p, StgClosure *src, nat size, step *stp)
-{
-    copy_tag(p,src,size,stp,0);
+    return to;
 }
 
 /* -----------------------------------------------------------------------------
@@ -276,7 +164,11 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val)
     prev = NULL;
     while (p)
     {
+#ifdef THREADED_RTS
+        ASSERT(p->header.info == &stg_WHITEHOLE_info);
+#else
         ASSERT(p->header.info == &stg_BLACKHOLE_info);
+#endif
         prev = (StgSelector*)((StgClosure *)p)->payload[0];
 
         // Update the THUNK_SELECTOR with an indirection to the
@@ -351,7 +243,7 @@ selector_chain:
     // In threaded mode, we'll use WHITEHOLE to lock the selector
     // thunk while we evaluate it.
     {
-	info_ptr = (StgInfoTable *)xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
+	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);
@@ -407,7 +299,7 @@ selector_loop:
 #ifdef PROFILING
               // For the purposes of LDV profiling, we have destroyed
               // the original selector thunk, p.
-              SET_INFO(p, info_ptr);
+              SET_INFO(p, (StgInfoTable *)info_ptr);
               LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)p);
               SET_INFO(p, &stg_BLACKHOLE_info);
 #endif