static I32 sortcv_xsub(pTHX_ SV *a, SV *b) { dSP; I32 oldsaveix = PL_savestack_ix; I32 oldscopeix = PL_scopestack_ix; I32 result; CV *cv=(CV*)PL_sortcop; SP = PL_stack_base; PUSHMARK(SP); EXTEND(SP, 2); *++SP = a; *++SP = b; PUTBACK; (void)(*CvXSUB(cv))(aTHX_ cv); if (PL_stack_sp != PL_stack_base + 1) Perl_croak(aTHX_ "Sort subroutine didn't return single value"); if (!SvNIOKp(*PL_stack_sp)) Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value"); result = SvIV(*PL_stack_sp); while (PL_scopestack_ix > oldscopeix) { LEAVE; } leave_scope(oldsaveix); return result; } void reduce(block,...) SV * block PROTOTYPE: &@ CODE: { SV *ret; int index; GV *agv,*bgv,*gv; HV *stash; CV *cv; OP *reducecop; PERL_CONTEXT *cx; SV** newsp; I32 gimme = G_SCALAR; U8 hasargs = 0; bool oldcatch = CATCH_GET; if(items <= 1) { XSRETURN_UNDEF; } agv = gv_fetchpv("a", TRUE, SVt_PV); bgv = gv_fetchpv("b", TRUE, SVt_PV); SAVESPTR(GvSV(agv)); SAVESPTR(GvSV(bgv)); cv = sv_2cv(block, &stash, &gv, 0); reducecop = CvSTART(cv); SAVESPTR(CvROOT(cv)->op_ppaddr); CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; #ifdef PAD_SET_CUR PAD_SET_CUR(CvPADLIST(cv),1); #else SAVESPTR(PL_curpad); PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); #endif SAVETMPS; SAVESPTR(PL_op); ret = ST(1); CATCH_SET(TRUE); PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB(cx); if (!CvDEPTH(cv)) (void)SvREFCNT_inc(cv); for(index = 2 ; index < items ; index++) { GvSV(agv) = ret; GvSV(bgv) = ST(index); PL_op = reducecop; CALLRUNOPS(aTHX); ret = *PL_stack_sp; } ST(0) = sv_mortalcopy(ret); POPBLOCK(cx,PL_curpm); CATCH_SET(oldcatch); XSRETURN(1); }