X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=17e519db2a745e16bdc002d86db77395089b5c79;hb=d13df738cbbe8017ae19ae2702f4e10805ee521b;hp=71c2be7550bcb2028e895bc002f4b173a11cf09f;hpb=a148ad2778c66fbfd75f138af6e6a22ab7c843fe;p=ghc-hetmet.git

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 71c2be7..17e519d 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -31,8 +31,6 @@ static void scavenge_large_bitmap (StgPtr p,
 				   StgLargeBitmap *large_bitmap, 
 				   nat size );
 
-static void scavenge_block (bdescr *bd, StgPtr scan);
-
 
 /* Similar to scavenge_large_bitmap(), but we don't write back the
  * pointers we get back from evacuate().
@@ -252,429 +250,6 @@ scavenge_AP (StgAP *ap)
 }
 
 /* -----------------------------------------------------------------------------
-   Scavenge a block from the given scan pointer up to bd->free.
-
-   evac_step is set by the caller to be either zero (for a step in a
-   generation < N) or G where G is the generation of the step being
-   scavenged.  
-
-   We sometimes temporarily change evac_step back to zero if we're
-   scavenging a mutable object where eager promotion isn't such a good
-   idea.  
-   -------------------------------------------------------------------------- */
-
-static void
-scavenge_block (bdescr *bd, StgPtr scan)
-{
-  StgPtr p, q;
-  StgInfoTable *info;
-  step *saved_evac_step;
-
-  p = scan;
-  
-  debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
-	     bd->start, bd->gen_no, bd->step->no, scan);
-
-  gct->evac_step = bd->step;
-  saved_evac_step = gct->evac_step;
-  gct->failed_to_evac = rtsFalse;
-
-  // we might be evacuating into the very object that we're
-  // scavenging, so we have to check the real bd->free pointer each
-  // time around the loop.
-  while (p < bd->free) {
-
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl((StgClosure *)p);
-    
-    ASSERT(gct->thunk_selector_depth == 0);
-
-    q = p;
-    switch (info->type) {
-
-    case MVAR_CLEAN:
-    case MVAR_DIRTY:
-    { 
-	rtsBool saved_eager_promotion = gct->eager_promotion;
-
-	StgMVar *mvar = ((StgMVar *)p);
-	gct->eager_promotion = rtsFalse;
-	evacuate((StgClosure **)&mvar->head);
-	evacuate((StgClosure **)&mvar->tail);
-	evacuate((StgClosure **)&mvar->value);
-	gct->eager_promotion = saved_eager_promotion;
-
-	if (gct->failed_to_evac) {
-	    mvar->header.info = &stg_MVAR_DIRTY_info;
-	} else {
-	    mvar->header.info = &stg_MVAR_CLEAN_info;
-	}
-	p += sizeofW(StgMVar);
-	break;
-    }
-
-    case FUN_2_0:
-	scavenge_fun_srt(info);
-	evacuate(&((StgClosure *)p)->payload[1]);
-	evacuate(&((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-
-    case THUNK_2_0:
-	scavenge_thunk_srt(info);
-	evacuate(&((StgThunk *)p)->payload[1]);
-	evacuate(&((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case CONSTR_2_0:
-	evacuate(&((StgClosure *)p)->payload[1]);
-	evacuate(&((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_0:
-	scavenge_thunk_srt(info);
-	evacuate(&((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_1_0:
-	scavenge_fun_srt(info);
-    case CONSTR_1_0:
-	evacuate(&((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_1:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_0_1:
-	scavenge_fun_srt(info);
-    case CONSTR_0_1:
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_2:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 2;
-	break;
-	
-    case FUN_0_2:
-	scavenge_fun_srt(info);
-    case CONSTR_0_2:
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_1:
-	scavenge_thunk_srt(info);
-	evacuate(&((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case FUN_1_1:
-	scavenge_fun_srt(info);
-    case CONSTR_1_1:
-	evacuate(&((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case FUN:
-	scavenge_fun_srt(info);
-	goto gen_obj;
-
-    case THUNK:
-    {
-	StgPtr end;
-
-	scavenge_thunk_srt(info);
-	end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-	    evacuate((StgClosure **)p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-	
-    gen_obj:
-    case CONSTR:
-    case WEAK:
-    case STABLE_NAME:
-    {
-	StgPtr end;
-
-	end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-	    evacuate((StgClosure **)p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-
-    case BCO: {
-	StgBCO *bco = (StgBCO *)p;
-	evacuate((StgClosure **)&bco->instrs);
-	evacuate((StgClosure **)&bco->literals);
-	evacuate((StgClosure **)&bco->ptrs);
-	p += bco_sizeW(bco);
-	break;
-    }
-
-    case IND_PERM:
-      if (bd->gen_no != 0) {
-#ifdef PROFILING
-        // @LDV profiling
-        // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an 
-        // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
-        LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
-#endif        
-        // 
-        // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
-        //
-	SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-
-        // We pretend that p has just been created.
-        LDV_RECORD_CREATE((StgClosure *)p);
-      }
-	// fall through 
-    case IND_OLDGEN_PERM:
-	evacuate(&((StgInd *)p)->indirectee);
-	p += sizeofW(StgInd);
-	break;
-
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY: {
-	rtsBool saved_eager_promotion = gct->eager_promotion;
-
-	gct->eager_promotion = rtsFalse;
-	evacuate(&((StgMutVar *)p)->var);
-	gct->eager_promotion = saved_eager_promotion;
-
-	if (gct->failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
-	}
-	p += sizeofW(StgMutVar);
-	break;
-    }
-
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
-    case BLACKHOLE:
-	p += BLACKHOLE_sizeW();
-	break;
-
-    case THUNK_SELECTOR:
-    { 
-	StgSelector *s = (StgSelector *)p;
-	evacuate(&s->selectee);
-	p += THUNK_SELECTOR_sizeW();
-	break;
-    }
-
-    // A chunk of stack saved in a heap object
-    case AP_STACK:
-    {
-	StgAP_STACK *ap = (StgAP_STACK *)p;
-
-	evacuate(&ap->fun);
-	scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	p = (StgPtr)ap->payload + ap->size;
-	break;
-    }
-
-    case PAP:
-	p = scavenge_PAP((StgPAP *)p);
-	break;
-
-    case AP:
-	p = scavenge_AP((StgAP *)p);
-	break;
-
-    case ARR_WORDS:
-	// nothing to follow 
-	p += arr_words_sizeW((StgArrWords *)p);
-	break;
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-	// follow everything 
-    {
-	StgPtr next;
-	rtsBool saved_eager;
-
-	// We don't eagerly promote objects pointed to by a mutable
-	// array, but if we find the array only points to objects in
-	// the same or an older generation, we mark it "clean" and
-	// avoid traversing it during minor GCs.
-	saved_eager = gct->eager_promotion;
-	gct->eager_promotion = rtsFalse;
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    evacuate((StgClosure **)p);
-	}
-	gct->eager_promotion = saved_eager;
-
-	if (gct->failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
-	}
-
-	gct->failed_to_evac = rtsTrue; // always put it on the mutable list.
-	break;
-    }
-
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	// follow everything 
-    {
-	StgPtr next;
-
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    evacuate((StgClosure **)p);
-	}
-
-	// If we're going to put this object on the mutable list, then
-	// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	if (gct->failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
-	}
-	break;
-    }
-
-    case TSO:
-    { 
-	StgTSO *tso = (StgTSO *)p;
-	rtsBool saved_eager = gct->eager_promotion;
-
-	gct->eager_promotion = rtsFalse;
-	scavengeTSO(tso);
-	gct->eager_promotion = saved_eager;
-
-	if (gct->failed_to_evac) {
-	    tso->flags |= TSO_DIRTY;
-	} else {
-	    tso->flags &= ~TSO_DIRTY;
-	}
-
-	gct->failed_to_evac = rtsTrue; // always on the mutable list
-	p += tso_sizeW(tso);
-	break;
-    }
-
-    case TVAR_WATCH_QUEUE:
-      {
-	StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
-	gct->evac_step = 0;
-	evacuate((StgClosure **)&wq->closure);
-	evacuate((StgClosure **)&wq->next_queue_entry);
-	evacuate((StgClosure **)&wq->prev_queue_entry);
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVarWatchQueue);
-	break;
-      }
-
-    case TVAR:
-      {
-	StgTVar *tvar = ((StgTVar *) p);
-	gct->evac_step = 0;
-	evacuate((StgClosure **)&tvar->current_value);
-	evacuate((StgClosure **)&tvar->first_watch_queue_entry);
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVar);
-	break;
-      }
-
-    case TREC_HEADER:
-      {
-        StgTRecHeader *trec = ((StgTRecHeader *) p);
-        gct->evac_step = 0;
-	evacuate((StgClosure **)&trec->enclosing_trec);
-	evacuate((StgClosure **)&trec->current_chunk);
-	evacuate((StgClosure **)&trec->invariants_to_check);
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecHeader);
-        break;
-      }
-
-    case TREC_CHUNK:
-      {
-	StgWord i;
-	StgTRecChunk *tc = ((StgTRecChunk *) p);
-	TRecEntry *e = &(tc -> entries[0]);
-	gct->evac_step = 0;
-	evacuate((StgClosure **)&tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  evacuate((StgClosure **)&e->tvar);
-	  evacuate((StgClosure **)&e->expected_value);
-	  evacuate((StgClosure **)&e->new_value);
-	}
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecChunk);
-	break;
-      }
-
-    case ATOMIC_INVARIANT:
-      {
-        StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
-        gct->evac_step = 0;
-	evacuate(&invariant->code);
-	evacuate((StgClosure **)&invariant->last_execution);
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgAtomicInvariant);
-        break;
-      }
-
-    case INVARIANT_CHECK_QUEUE:
-      {
-        StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
-        gct->evac_step = 0;
-	evacuate((StgClosure **)&queue->invariant);
-	evacuate((StgClosure **)&queue->my_execution);
-	evacuate((StgClosure **)&queue->next_queue_entry);
-	gct->evac_step = saved_evac_step;
-	gct->failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgInvariantCheckQueue);
-        break;
-      }
-
-    default:
-	barf("scavenge: unimplemented/strange closure type %d @ %p", 
-	     info->type, p);
-    }
-
-    /*
-     * We need to record the current object on the mutable list if
-     *  (a) It is actually mutable, or 
-     *  (b) It contains pointers to a younger generation.
-     * Case (b) arises if we didn't manage to promote everything that
-     * the current object points to into the current generation.
-     */
-    if (gct->failed_to_evac) {
-	gct->failed_to_evac = rtsFalse;
-	if (bd->gen_no > 0) {
-	    recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
-	}
-    }
-  }
-
-  debugTrace(DEBUG_gc, "   scavenged %ld bytes", (bd->free - scan) * sizeof(W_));
-}    
-
-/* -----------------------------------------------------------------------------
    Scavenge everything on the mark stack.
 
    This is slightly different from scavenge():
@@ -1813,6 +1388,15 @@ scavenge_large (step_workspace *ws)
 }
 
 /* ----------------------------------------------------------------------------
+   Scavenge a block
+   ------------------------------------------------------------------------- */
+
+#define MINOR_GC
+#include "Scav.c-inc"
+#undef MINOR_GC
+#include "Scav.c-inc"
+
+/* ----------------------------------------------------------------------------
    Find the oldest full block to scavenge, and scavenge it.
    ------------------------------------------------------------------------- */
 
@@ -1843,7 +1427,11 @@ scavenge_find_global_work (void)
 		// to scavenge the whole thing and then push it on
 		// our scavd list.  This saves pushing out the
 		// scan_bd block, which might be partial.
-		scavenge_block(bd, bd->start);
+		if (N == 0) {
+		    scavenge_block0(bd, bd->start);
+		} else {
+		    scavenge_block(bd, bd->start);
+		}
 		push_scan_block(bd, ws);
 		return rtsTrue;
 	    }
@@ -1893,7 +1481,11 @@ scavenge_find_local_work (void)
 	    // scavenge everything up to the free pointer.
 	    if (ws->scan != NULL && ws->scan < ws->scan_bd->free)
 	    {
-		scavenge_block(ws->scan_bd, ws->scan);
+		if (N == 0) {
+		    scavenge_block0(ws->scan_bd, ws->scan);
+		} else {
+		    scavenge_block(ws->scan_bd, ws->scan);
+		}
 		ws->scan = ws->scan_bd->free;
 		flag = rtsTrue;
 	    }