+ StgClosure *frame;
+ StgRetInfoTable *info;
+ StgClosure *bh;
+ StgPtr stack_end;
+ nat words_to_squeeze = 0;
+ nat weight = 0;
+ nat weight_pending = 0;
+ rtsBool prev_was_update_frame;
+
+ stack_end = &tso->stack[tso->stack_size];
+
+ frame = (StgClosure *)tso->sp;
+
+ while (1) {
+ // If we've already marked this frame, then stop here.
+ if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
+ goto end;
+ }
+
+ info = get_ret_itbl(frame);
+
+ switch (info->i.type) {
+
+ case UPDATE_FRAME:
+
+ SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
+
+ bh = ((StgUpdateFrame *)frame)->updatee;
+
+ if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
+ IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %d words of stack\n", (StgPtr)frame - tso->sp));
+
+ // If this closure is already an indirection, then
+ // suspend the computation up to this point:
+ suspendComputation(cap,tso,(StgPtr)frame);
+
+ // Now drop the update frame, and arrange to return
+ // the value to the frame underneath:
+ tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
+ tso->sp[1] = (StgWord)bh;
+ tso->sp[0] = (W_)&stg_enter_info;
+
+ // And continue with threadPaused; there might be
+ // yet more computation to suspend.
+ threadPaused(cap,tso);
+ return;
+ }
+
+ if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
+#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
+ debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh);
+#endif
+ // zero out the slop so that the sanity checker can tell
+ // where the next closure is.
+ DEBUG_FILL_SLOP(bh);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh is now dead.
+ LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
+ SET_INFO(bh,&stg_BLACKHOLE_info);
+
+ // We pretend that bh has just been created.
+ LDV_RECORD_CREATE(bh);
+ }
+
+ frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
+ if (prev_was_update_frame) {
+ words_to_squeeze += sizeofW(StgUpdateFrame);
+ weight += weight_pending;
+ weight_pending = 0;
+ }
+ prev_was_update_frame = rtsTrue;
+ break;
+
+ case STOP_FRAME:
+ goto end;
+
+ // normal stack frames; do nothing except advance the pointer
+ default:
+ {
+ nat frame_size = stack_frame_sizeW(frame);
+ weight_pending += frame_size;
+ frame = (StgClosure *)((StgPtr)frame + frame_size);
+ prev_was_update_frame = rtsFalse;
+ }
+ }
+ }
+
+end:
+ IF_DEBUG(squeeze,
+ debugBelch("words_to_squeeze: %d, weight: %d, squeeze: %s\n",
+ words_to_squeeze, weight,
+ weight < words_to_squeeze ? "YES" : "NO"));
+
+ // Should we squeeze or not? Arbitrary heuristic: we squeeze if
+ // the number of words we have to shift down is less than the
+ // number of stack words we squeeze away by doing so.
+ if (1 /*RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
+ weight < words_to_squeeze*/) {
+ stackSqueeze(tso, (StgPtr)frame);
+ }