path: root/rts/sm/Scav.c-inc

/* -----------------------------------------------------------------------*-c-*-
 *
 * (c) The GHC Team 1998-2006
 *
 * Generational garbage collector: scavenging functions
 *
 * Documentation on the architecture of the Garbage Collector can be
 * found in the online commentary:
 * 
 *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
 *
 * ---------------------------------------------------------------------------*/

// This file is #included into Scav.c, twice: firstly with PARALLEL_GC
// defined, the second time without.

#ifndef PARALLEL_GC
#define scavenge_block(a) scavenge_block1(a)
#define evacuate(a) evacuate1(a)
#define recordMutableGen_GC(a,b) recordMutableGen(a,b)
#else
#undef scavenge_block
#undef evacuate
#undef recordMutableGen_GC
#endif

static void scavenge_block (bdescr *bd);

/* -----------------------------------------------------------------------------
   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 p, q;
  StgInfoTable *info;
  step *saved_evac_step;
  rtsBool saved_eager_promotion;
  step_workspace *ws;

  p = bd->u.scan;
  
  debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
	     bd->start, bd->gen_no, bd->step->no, p);

  gct->evac_step = bd->step;
  saved_evac_step = gct->evac_step;
  saved_eager_promotion = gct->eager_promotion;
  gct->failed_to_evac = rtsFalse;

  ws = &gct->steps[bd->step->abs_no];

  // 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 || (bd == ws->todo_bd && p < ws->todo_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:
    { 
	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:
	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;

	// 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.
	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_promotion;

	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;

	gct->eager_promotion = rtsFalse;
	scavengeTSO(tso);
	gct->eager_promotion = saved_eager_promotion;

	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]);
	}
    }
  }

  if (p > bd->free)  {
      gct->copied += ws->todo_free - bd->free;
      bd->free = p;
  }

  debugTrace(DEBUG_gc, "   scavenged %ld bytes",
             (unsigned long)((bd->free - bd->u.scan) * sizeof(W_)));

  // update stats: this is a block that has been scavenged
  gct->scanned += bd->free - bd->u.scan;
  bd->u.scan = bd->free;
}

#undef scavenge_block
#undef evacuate
#undef recordMutableGen_GC