void reduce(block,...) SV * block PROTOTYPE: &@ CODE: { SV *ret = sv_newmortal(); 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)); GvSV(agv) = ret; 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); SvSetSV(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(bgv) = ST(index); PL_op = reducecop; CALLRUNOPS(aTHX); SvSetSV(ret, *PL_stack_sp); } ST(0) = ret; POPBLOCK(cx,PL_curpm); CATCH_SET(oldcatch); XSRETURN(1); }