+/* --- Yield --------------------------------------------------------------- */
+
+#if SU_HAS_PERL(5, 10, 0)
+# define SU_RETOP_SUB(C) ((C)->blk_sub.retop)
+# define SU_RETOP_EVAL(C) ((C)->blk_eval.retop)
+# define SU_RETOP_LOOP(C) ((C)->blk_loop.my_op->op_lastop->op_next)
+# define SU_RETOP_GIVEN(C) ((C)->blk_givwhen.leave_op->op_next)
+#else
+# define SU_RETOP_SUB(C) ((C)->blk_oldretsp > 0 ? PL_retstack[(C)->blk_oldretsp - 1] : NULL)
+# define SU_RETOP_EVAL(C) SU_RETOP_SUB(C)
+# define SU_RETOP_LOOP(C) ((C)->blk_loop.last_op->op_next)
+#endif
+
+STATIC void su_yield(pTHX_ void *ud_) {
+ dMY_CXT;
+ PERL_CONTEXT *cx;
+ const char *which = ud_;
+ I32 cxix = MY_CXT.yield_storage.cxix;
+ I32 items = MY_CXT.yield_storage.items;
+ opcode type = OP_NULL;
+ U8 flags = 0;
+ OP *next;
+
+ PERL_UNUSED_VAR(ud_);
+
+ cx = cxstack + cxix;
+ switch (CxTYPE(cx)) {
+ case CXt_BLOCK: {
+ I32 i, cur = cxstack_ix, n = 1;
+ OP *o = NULL;
+ /* Is this actually a given/when block? This may occur only when yield was
+ * called with HERE (or nothing) as the context. */
+#if SU_HAS_PERL(5, 10, 0)
+ if (cxix > 0) {
+ PERL_CONTEXT *prev = cx - 1;
+ U8 type = CxTYPE(prev);
+ if ((type == CXt_GIVEN || type == CXt_WHEN)
+ && (prev->blk_oldcop == cx->blk_oldcop)) {
+ cxix--;
+ cx = prev;
+ if (type == CXt_GIVEN)
+ goto cxt_given;
+ else
+ goto cxt_when;
+ }
+ }
+#endif
+ type = OP_LEAVE;
+ next = NULL;
+ /* Bare blocks (that appear as do { ... } blocks, map { ... } blocks or
+ * constant folded blcoks) don't need to save the op to return to anywhere
+ * since 'last' isn't supposed to work inside them. So we climb higher in
+ * the context stack until we reach a context that has a return op (i.e. a
+ * sub, an eval, a format or a real loop), recording how many blocks we
+ * crossed. Then we follow the op_next chain until we get to the leave op
+ * that closes the original block, which we are assured to reach since
+ * everything is static (the blocks we have crossed cannot be evals or
+ * subroutine calls). */
+ for (i = cxix + 1; i <= cur; ++i) {
+ PERL_CONTEXT *cx2 = cxstack + i;
+ switch (CxTYPE(cx2)) {
+ case CXt_BLOCK:
+ ++n;
+ break;
+ case CXt_SUB:
+ case CXt_FORMAT:
+ o = SU_RETOP_SUB(cx2);
+ break;
+ case CXt_EVAL:
+ o = SU_RETOP_EVAL(cx2);
+ break;
+#if SU_HAS_PERL(5, 11, 0)
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_LAZYIV:
+#else
+ case CXt_LOOP:
+#endif
+ o = SU_RETOP_LOOP(cx2);
+ break;
+ }
+ if (o)
+ break;
+ }
+ if (!o)
+ o = PL_op;
+ while (n && o) {
+ /* We may find other enter/leave blocks on our way to the matching leave.
+ * Make sure the depth is incremented/decremented appropriately. */
+ if (o->op_type == OP_ENTER) {
+ ++n;
+ } else if (o->op_type == OP_LEAVE) {
+ --n;
+ if (!n) {
+ next = o->op_next;
+ break;
+ }
+ }
+ o = o->op_next;
+ }
+ break;
+ }
+ case CXt_SUB:
+ case CXt_FORMAT:
+ type = OP_LEAVESUB;
+ next = SU_RETOP_SUB(cx);
+ break;
+ case CXt_EVAL:
+ type = CxTRYBLOCK(cx) ? OP_LEAVETRY : OP_LEAVEEVAL;
+ next = SU_RETOP_EVAL(cx);
+ break;
+#if SU_HAS_PERL(5, 11, 0)
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_LAZYIV:
+#else
+ case CXt_LOOP:
+#endif
+ type = OP_LEAVELOOP;
+ next = SU_RETOP_LOOP(cx);
+ break;
+#if SU_HAS_PERL(5, 10, 0)
+ case CXt_GIVEN:
+cxt_given:
+ type = OP_LEAVEGIVEN;
+ next = SU_RETOP_GIVEN(cx);
+ break;
+ case CXt_WHEN:
+cxt_when:
+#if SU_HAS_PERL(5, 15, 1)
+ type = OP_LEAVEWHEN;
+#else
+ type = OP_BREAK;
+ flags |= OPf_SPECIAL;
+#endif
+ next = NULL;
+ break;
+#endif
+ case CXt_SUBST:
+ croak("%s() can't target a substitution context", which);
+ break;
+ default:
+ croak("%s() doesn't know how to leave a %s context",
+ which, SU_CXNAME(cxstack + cxix));
+ break;
+ }
+
+ PL_stack_sp = MY_CXT.yield_storage.savesp;
+
+ if (cxstack_ix > cxix)
+ dounwind(cxix);
+
+ /* Copy the arguments passed to yield() where the leave op expects to find
+ * them. */
+ if (items)
+ Move(PL_stack_sp - items + 1, PL_stack_base + cx->blk_oldsp + 1, items, SV *);
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp + items;
+
+ flags |= OP_GIMME_REVERSE(cx->blk_gimme);
+
+ MY_CXT.yield_storage.leave_op.op_type = type;
+ MY_CXT.yield_storage.leave_op.op_ppaddr = PL_ppaddr[type];
+ MY_CXT.yield_storage.leave_op.op_flags = flags;
+ MY_CXT.yield_storage.leave_op.op_next = next;
+
+ PL_op = (OP *) &(MY_CXT.yield_storage.leave_op);
+ PL_op = PL_op->op_ppaddr(aTHX);
+
+ MY_CXT.yield_storage.proxy_op.op_next = PL_op;
+ PL_op = &(MY_CXT.yield_storage.proxy_op);
+}
+