+#define SU_DOPOPTOCX(t) \
+ STMT_START { \
+ I32 i, cxix = cxstack_ix, level = 0; \
+ if (items) { \
+ SV *lsv = ST(0); \
+ if (SvOK(lsv)) \
+ level = SvIV(lsv); \
+ if (level < 0) \
+ level = 0; \
+ else if (level > cxix) \
+ level = cxix; \
+ } \
+ for (i = cxix - level; i >= 0; --i) { \
+ if (CxTYPE(&cxstack[i]) == t) { \
+ ST(0) = sv_2mortal(newSViv(cxix - i)); \
+ XSRETURN(1); \
+ } \
+ } \
+ XSRETURN_UNDEF; \
+ } STMT_END
+
+XS(XS_Scope__Upper_unwind); /* prototype to pass -Wmissing-prototypes */
+
+XS(XS_Scope__Upper_unwind) {
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ I32 level = 0, cxix = cxstack_ix;
+ su_ud_unwind *ud;
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(ax); /* -Wall */
+ if (items) {
+ SV *lsv = ST(items - 1);
+ if (SvOK(lsv))
+ level = SvIV(lsv);
+ if (level < 0)
+ level = 0;
+ else if (level > cxix)
+ level = cxix;
+ }
+ cxix -= level;
+ do {
+ PERL_CONTEXT *cx = cxstack + cxix;
+ switch (CxTYPE(cx)) {
+ case CXt_SUB:
+ case CXt_EVAL:
+ case CXt_FORMAT:
+ /* pp_entersub will try to sanitize the stack - screw that, we're insane */
+ if (GIMME_V == G_SCALAR)
+ PL_stack_sp = PL_stack_base + TOPMARK + 1;
+ Newx(ud, 1, su_ud_unwind);
+ ud->cxix = cxix;
+ ud->items = items;
+ SAVEDESTRUCTOR_X(su_unwind, ud);
+ return;
+ default:
+ break;
+ }
+ } while (--cxix >= 0);
+ croak("Can't return outside a subroutine");
+}