+ p += arr_words_sizeW((StgArrWords *)p);
+ break;
+
+ case MUT_ARR_PTRS:
+ /* follow everything */
+ {
+ StgPtr next;
+
+ evac_gen = 0; /* repeatedly mutable */
+ next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ (StgClosure *)*p = evacuate((StgClosure *)*p);
+ }
+ evac_gen = saved_evac_gen;
+ break;
+ }
+
+ case MUT_ARR_PTRS_FROZEN:
+ /* follow everything */
+ {
+ StgPtr start = p, next;
+
+ next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ (StgClosure *)*p = evacuate((StgClosure *)*p);
+ }
+ if (failed_to_evac) {
+ /* we can do this easier... */
+ recordMutable((StgMutClosure *)start);
+ failed_to_evac = rtsFalse;
+ }
+ break;
+ }
+
+ case TSO:
+ {
+ StgTSO *tso = (StgTSO *)p;
+ evac_gen = 0;
+ scavengeTSO(tso);
+ evac_gen = saved_evac_gen;
+ p += tso_sizeW(tso);
+ break;
+ }
+
+#if defined(PAR)
+ case RBH: // cf. BLACKHOLE_BQ
+ {
+ // nat size, ptrs, nonptrs, vhs;
+ // char str[80];
+ // StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
+ StgRBH *rbh = (StgRBH *)p;
+ (StgClosure *)rbh->blocking_queue =
+ evacuate((StgClosure *)rbh->blocking_queue);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ recordMutable((StgMutClosure *)rbh);
+ }
+ IF_DEBUG(gc,
+ belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+ p, info_type(p), (StgClosure *)rbh->blocking_queue));
+ // ToDo: use size of reverted closure here!
+ p += BLACKHOLE_sizeW();
+ break;
+ }
+
+ case BLOCKED_FETCH:
+ {
+ StgBlockedFetch *bf = (StgBlockedFetch *)p;
+ /* follow the pointer to the node which is being demanded */
+ (StgClosure *)bf->node =
+ evacuate((StgClosure *)bf->node);
+ /* follow the link to the rest of the blocking queue */
+ (StgClosure *)bf->link =
+ evacuate((StgClosure *)bf->link);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ recordMutable((StgMutClosure *)bf);
+ }
+ IF_DEBUG(gc,
+ belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
+ bf, info_type((StgClosure *)bf),
+ bf->node, info_type(bf->node)));
+ p += sizeofW(StgBlockedFetch);
+ break;
+ }
+
+#ifdef DIST
+ case REMOTE_REF:
+#endif
+ case FETCH_ME:
+ p += sizeofW(StgFetchMe);
+ break; // nothing to do in this case
+
+ case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
+ {
+ StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
+ (StgClosure *)fmbq->blocking_queue =
+ evacuate((StgClosure *)fmbq->blocking_queue);
+ if (failed_to_evac) {
+ failed_to_evac = rtsFalse;
+ recordMutable((StgMutClosure *)fmbq);
+ }
+ IF_DEBUG(gc,
+ belch("@@ scavenge: %p (%s) exciting, isn't it",
+ p, info_type((StgClosure *)p)));
+ p += sizeofW(StgFetchMeBlockingQueue);
+ break;
+ }
+#endif
+
+ case EVACUATED:
+ barf("scavenge: unimplemented/strange closure type %d @ %p",
+ info->type, p);
+
+ default:
+ barf("scavenge: unimplemented/strange closure type %d @ %p",
+ info->type, p);
+ }
+
+ /* If we didn't manage to promote all the objects pointed to by
+ * the current object, then we have to designate this object as
+ * mutable (because it contains old-to-new generation pointers).
+ */
+ if (failed_to_evac) {
+ mkMutCons((StgClosure *)q, &generations[evac_gen]);
+ failed_to_evac = rtsFalse;
+ }
+ }
+
+ stp->scan_bd = bd;
+ stp->scan = p;
+}
+
+/* -----------------------------------------------------------------------------
+ Scavenge one object.
+
+ This is used for objects that are temporarily marked as mutable
+ because they contain old-to-new generation pointers. Only certain
+ objects can have this property.
+ -------------------------------------------------------------------------- */
+//@cindex scavenge_one
+
+static rtsBool
+scavenge_one(StgClosure *p)
+{
+ const StgInfoTable *info;
+ rtsBool no_luck;
+
+ ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
+ || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
+
+ info = get_itbl(p);
+
+ /* ngoq moHqu'!
+ if (info->type==RBH)
+ info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
+ */
+
+ switch (info -> type) {
+
+ case FUN:
+ case FUN_1_0: /* hardly worth specialising these guys */
+ case FUN_0_1:
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_2_0:
+ case THUNK:
+ case THUNK_1_0:
+ case THUNK_0_1:
+ case THUNK_1_1:
+ case THUNK_0_2:
+ case THUNK_2_0:
+ case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
+ case CONSTR_2_0:
+ case WEAK:
+ case FOREIGN:
+ case IND_PERM:
+ case IND_OLDGEN_PERM:
+ {
+ StgPtr q, end;
+
+ end = (P_)p->payload + info->layout.payload.ptrs;
+ for (q = (P_)p->payload; q < end; q++) {
+ (StgClosure *)*q = evacuate((StgClosure *)*q);
+ }
+ break;
+ }
+
+ case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
+ case BLACKHOLE:
+ break;
+
+ case THUNK_SELECTOR:
+ {
+ StgSelector *s = (StgSelector *)p;
+ s->selectee = evacuate(s->selectee);
+ break;
+ }
+
+ case AP_UPD: /* same as PAPs */
+ case PAP:
+ /* Treat a PAP just like a section of stack, not forgetting to
+ * evacuate the function pointer too...
+ */
+ {
+ StgPAP* pap = (StgPAP *)p;
+
+ pap->fun = evacuate(pap->fun);
+ scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
+ break;
+ }
+
+ case IND_OLDGEN:
+ /* This might happen if for instance a MUT_CONS was pointing to a
+ * THUNK which has since been updated. The IND_OLDGEN will
+ * be on the mutable list anyway, so we don't need to do anything
+ * here.
+ */
+ break;
+
+ default:
+ barf("scavenge_one: strange object %d", (int)(info->type));
+ }
+
+ no_luck = failed_to_evac;
+ failed_to_evac = rtsFalse;
+ return (no_luck);
+}
+
+
+/* -----------------------------------------------------------------------------
+ Scavenging mutable lists.
+
+ We treat the mutable list of each generation > N (i.e. all the
+ generations older than the one being collected) as roots. We also
+ remove non-mutable objects from the mutable list at this point.
+ -------------------------------------------------------------------------- */
+//@cindex scavenge_mut_once_list