X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=716be5eb12e7cf030b618da86dde8d80748d0fb3;hb=393fec973b1b95a178b4b9600173880d9f93debf;hp=c9afbb6601b30cca683bdfa8e120681d994196fd;hpb=5bc28da93666e223bb56098f72517273bc8bcbf9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index c9afbb6..716be5e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -27,6 +27,8 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) static I32 sortcv(pTHXo_ SV *a, SV *b); +static I32 sortcv_stacked(pTHXo_ SV *a, SV *b); +static I32 sortcv_xsub(pTHXo_ SV *a, SV *b); static I32 sv_ncmp(pTHXo_ SV *a, SV *b); static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b); static I32 amagic_ncmp(pTHXo_ SV *a, SV *b); @@ -112,6 +114,8 @@ PP(pp_regcomp) PL_reginterp_cnt = I32_MAX; /* Mark as safe. */ pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */ + if (DO_UTF8(tmpstr)) + pm->op_pmdynflags |= PMdf_UTF8; pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm); PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed inside tie/overload accessors. */ @@ -132,9 +136,13 @@ PP(pp_regcomp) else if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; + /* XXX runtime compiled output needs to move to the pad */ if (pm->op_pmflags & PMf_KEEP) { pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ +#if !defined(USE_ITHREADS) && !defined(USE_THREADS) + /* XXX can't change the optree at runtime either */ cLOGOP->op_first->op_next = PL_op->op_next; +#endif } RETURN; } @@ -290,7 +298,8 @@ PP(pp_formline) NV value; bool gotsome; STRLEN len; - STRLEN fudge = SvCUR(tmpForm) * (IN_UTF8 ? 3 : 1) + 1; + STRLEN fudge = SvCUR(tmpForm) * (IN_BYTE ? 1 : 3) + 1; + bool item_is_utf = FALSE; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { SvREADONLY_off(tmpForm); @@ -330,9 +339,9 @@ PP(pp_formline) case FF_END: name = "END"; break; } if (arg >= 0) - PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg); + PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); else - PerlIO_printf(PerlIO_stderr(), "%-16s\n", name); + PerlIO_printf(Perl_debug_log, "%-16s\n", name); } ) switch (*fpc++) { case FF_LINEMARK: @@ -368,7 +377,7 @@ PP(pp_formline) case FF_CHECKNL: item = s = SvPV(sv, len); itemsize = len; - if (IN_UTF8) { + if (DO_UTF8(sv)) { itemsize = sv_len_utf8(sv); if (itemsize != len) { I32 itembytes; @@ -387,11 +396,13 @@ PP(pp_formline) break; s++; } + item_is_utf = TRUE; itemsize = s - item; sv_pos_b2u(sv, &itemsize); break; } } + item_is_utf = FALSE; if (itemsize > fieldsize) itemsize = fieldsize; send = chophere = s + itemsize; @@ -408,7 +419,7 @@ PP(pp_formline) case FF_CHECKCHOP: item = s = SvPV(sv, len); itemsize = len; - if (IN_UTF8) { + if (DO_UTF8(sv)) { itemsize = sv_len_utf8(sv); if (itemsize != len) { I32 itembytes; @@ -446,9 +457,11 @@ PP(pp_formline) itemsize = chophere - item; sv_pos_b2u(sv, &itemsize); } + item_is_utf = TRUE; break; } } + item_is_utf = FALSE; if (itemsize <= fieldsize) { send = chophere = s + itemsize; while (s < send) { @@ -504,7 +517,7 @@ PP(pp_formline) case FF_ITEM: arg = itemsize; s = item; - if (IN_UTF8) { + if (item_is_utf) { while (arg--) { if (*s & 0x80) { switch (UTF8SKIP(s)) { @@ -547,6 +560,7 @@ PP(pp_formline) case FF_LINEGLOB: item = s = SvPV(sv, len); itemsize = len; + item_is_utf = FALSE; /* XXX is this correct? */ if (itemsize) { gotsome = TRUE; send = s + itemsize; @@ -686,7 +700,7 @@ PP(pp_grepstart) /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ SAVESPTR(DEFSV); ENTER; /* enter inner scope */ - SAVESPTR(PL_curpm); + SAVEVPTR(PL_curpm); src = PL_stack_base[*PL_markstack_ptr]; SvTEMP_off(src); @@ -756,7 +770,7 @@ PP(pp_mapwhile) SV *src; ENTER; /* enter inner scope */ - SAVESPTR(PL_curpm); + SAVEVPTR(PL_curpm); src = PL_stack_base[PL_markstack_ptr[-1]]; SvTEMP_off(src); @@ -778,6 +792,8 @@ PP(pp_sort) I32 gimme = GIMME; OP* nextop = PL_op->op_next; I32 overloading = 0; + bool hasargs = FALSE; + I32 is_xsub = 0; if (gimme != G_ARRAY) { SP = MARK; @@ -785,44 +801,54 @@ PP(pp_sort) } ENTER; - SAVEPPTR(PL_sortcop); + SAVEVPTR(PL_sortcop); if (PL_op->op_flags & OPf_STACKED) { if (PL_op->op_flags & OPf_SPECIAL) { OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */ kid = kUNOP->op_first; /* pass rv2gv */ kid = kUNOP->op_first; /* pass leave */ PL_sortcop = kid->op_next; - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } else { cv = sv_2cv(*++MARK, &stash, &gv, 0); + if (cv && SvPOK(cv)) { + STRLEN n_a; + char *proto = SvPV((SV*)cv, n_a); + if (proto && strEQ(proto, "$$")) { + hasargs = TRUE; + } + } if (!(cv && CvROOT(cv))) { - if (gv) { + if (cv && CvXSUB(cv)) { + is_xsub = 1; + } + else if (gv) { SV *tmpstr = sv_newmortal(); gv_efullname3(tmpstr, gv, Nullch); - if (cv && CvXSUB(cv)) - DIE(aTHX_ "Xsub \"%s\" called in sort", SvPVX(tmpstr)); DIE(aTHX_ "Undefined sort subroutine \"%s\" called", SvPVX(tmpstr)); } - if (cv) { - if (CvXSUB(cv)) - DIE(aTHX_ "Xsub called in sort"); + else { DIE(aTHX_ "Undefined subroutine in sort"); } - DIE(aTHX_ "Not a CODE reference in sort"); } - PL_sortcop = CvSTART(cv); - SAVESPTR(CvROOT(cv)->op_ppaddr); - CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; - SAVESPTR(PL_curpad); - PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + if (is_xsub) + PL_sortcop = (OP*)cv; + else { + PL_sortcop = CvSTART(cv); + SAVEVPTR(CvROOT(cv)->op_ppaddr); + CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; + + SAVEVPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + } } } else { PL_sortcop = Nullop; - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } up = myorigmark + 1; @@ -863,7 +889,6 @@ PP(pp_sort) PUSHBLOCK(cx, CXt_NULL, PL_stack_base); if (!(PL_op->op_flags & OPf_SPECIAL)) { - bool hasargs = FALSE; cx->cx_type = CXt_SUB; cx->blk_gimme = G_SCALAR; PUSHSUB(cx); @@ -871,7 +896,19 @@ PP(pp_sort) (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ } PL_sortcxix = cxstack_ix; - qsortsv((myorigmark+1), max, sortcv); + + if (hasargs && !is_xsub) { + /* This is mostly copied from pp_entersub */ + AV *av = (AV*)PL_curpad[0]; + +#ifndef USE_THREADS + cx->blk_sub.savearray = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); +#endif /* USE_THREADS */ + cx->blk_sub.argarray = av; + } + qsortsv((myorigmark+1), max, + is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); POPBLOCK(cx,PL_curpm); PL_stack_sp = newsp; @@ -968,10 +1005,12 @@ PP(pp_flop) mg_get(right); if (SvNIOKp(left) || !SvPOKp(left) || - (looks_like_number(left) && *SvPVX(left) != '0') ) + SvNIOKp(right) || !SvPOKp(right) || + (looks_like_number(left) && *SvPVX(left) != '0' && + looks_like_number(right) && *SvPVX(right) != '0')) { if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX) - Perl_croak(aTHX_ "Range iterator outside integer range"); + DIE(aTHX_ "Range iterator outside integer range"); i = SvIV(left); max = SvIV(right); if (max >= i) { @@ -1040,6 +1079,11 @@ S_dopoptolabel(pTHX_ char *label) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s", PL_op_name[PL_op->op_type]); break; + case CXt_FORMAT: + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s", + PL_op_name[PL_op->op_type]); + break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s", @@ -1115,6 +1159,7 @@ S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) continue; case CXt_EVAL: case CXt_SUB: + case CXt_FORMAT: DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i)); return i; } @@ -1160,6 +1205,11 @@ S_dopoptoloop(pTHX_ I32 startingblock) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s", PL_op_name[PL_op->op_type]); break; + case CXt_FORMAT: + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s", + PL_op_name[PL_op->op_type]); + break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s", @@ -1187,6 +1237,7 @@ Perl_dounwind(pTHX_ I32 cxix) I32 optype; while (cxstack_ix > cxix) { + SV *sv; cx = &cxstack[cxstack_ix]; DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix, PL_block_type[CxTYPE(cx)])); @@ -1196,7 +1247,8 @@ Perl_dounwind(pTHX_ I32 cxix) POPSUBST(cx); continue; /* not break */ case CXt_SUB: - POPSUB(cx); + POPSUB(cx,sv); + LEAVESUB(sv); break; case CXt_EVAL: POPEVAL(cx); @@ -1206,6 +1258,9 @@ Perl_dounwind(pTHX_ I32 cxix) break; case CXt_NULL: break; + case CXt_FORMAT: + POPFORMAT(cx); + break; } cxstack_ix--; } @@ -1247,6 +1302,18 @@ S_free_closures(pTHX) } } +void +Perl_qerror(pTHX_ SV *err) +{ + if (PL_in_eval) + sv_catsv(ERRSV, err); + else if (PL_errors) + sv_catsv(PL_errors, err); + else + Perl_warn(aTHX_ "%"SVf, err); + ++PL_error_count; +} + OP * Perl_die_where(pTHX_ char *message, STRLEN msglen) { @@ -1260,26 +1327,25 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) if (message) { if (PL_in_eval & EVAL_KEEPERR) { - SV **svp; - - svp = hv_fetch(ERRHV, message, msglen, TRUE); - if (svp) { - if (!SvIOK(*svp)) { - static char prefix[] = "\t(in cleanup) "; - SV *err = ERRSV; - sv_upgrade(*svp, SVt_IV); - (void)SvIOK_only(*svp); - if (!SvPOK(err)) - sv_setpv(err,""); - SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); - sv_catpvn(err, prefix, sizeof(prefix)-1); - sv_catpvn(err, message, msglen); - if (ckWARN(WARN_UNSAFE)) { - STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); - } + static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; + char *e = Nullch; + if (!SvPOK(err)) + sv_setpv(err,""); + else if (SvCUR(err) >= sizeof(prefix)+msglen-1) { + e = SvPV(err, n_a); + e += n_a - msglen; + if (*e != *message || strNE(e,message)) + e = Nullch; + } + if (!e) { + SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, msglen); + if (ckWARN(WARN_UNSAFE)) { + STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; + Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); } - sv_inc(*svp); } } else @@ -1288,7 +1354,9 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) else message = SvPVx(ERRSV, msglen); - while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { + while ((cxix = dopoptoeval(cxstack_ix)) < 0 + && PL_curstackinfo->si_prev) + { dounwind(-1); POPSTACK; } @@ -1301,8 +1369,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) POPBLOCK(cx,PL_curpm); if (CxTYPE(cx) != CXt_EVAL) { - PerlIO_write(PerlIO_stderr(), "panic: die ", 11); - PerlIO_write(PerlIO_stderr(), message, msglen); + PerlIO_write(Perl_error_log, "panic: die ", 11); + PerlIO_write(Perl_error_log, message, msglen); my_exit(1); } POPEVAL(cx); @@ -1315,7 +1383,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) if (optype == OP_REQUIRE) { char* msg = SvPVx(ERRSV, n_a); - DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require"); + DIE(aTHX_ "%sCompilation failed in require", + *msg ? msg : "Unknown error\n"); } return pop_return(); } @@ -1327,8 +1396,10 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) /* SFIO can really mess with your errno */ int e = errno; #endif - PerlIO_write(PerlIO_stderr(), message, msglen); - (void)PerlIO_flush(PerlIO_stderr()); + PerlIO *serr = Perl_error_log; + + PerlIO_write(serr, message, msglen); + (void)PerlIO_flush(serr); #ifdef USE_SFIO errno = e; #endif @@ -1374,7 +1445,7 @@ PP(pp_caller) PERL_SI *top_si = PL_curstackinfo; I32 dbcxix; I32 gimme; - HV *hv; + char *stashname; SV *sv; I32 count = 0; @@ -1402,7 +1473,7 @@ PP(pp_caller) } cx = &ccstack[cxix]; - if (CxTYPE(cx) == CXt_SUB) { + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { dbcxix = dopoptosub_at(ccstack, cxix - 1); /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ @@ -1410,29 +1481,28 @@ PP(pp_caller) cx = &ccstack[dbcxix]; } + stashname = CopSTASHPV(cx->blk_oldcop); if (GIMME != G_ARRAY) { - hv = cx->blk_oldcop->cop_stash; - if (!hv) + if (!stashname) PUSHs(&PL_sv_undef); else { dTARGET; - sv_setpv(TARG, HvNAME(hv)); + sv_setpv(TARG, stashname); PUSHs(TARG); } RETURN; } - hv = cx->blk_oldcop->cop_stash; - if (!hv) + if (!stashname) PUSHs(&PL_sv_undef); else - PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0))); - PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), - SvCUR(GvSV(cx->blk_oldcop->cop_filegv))))); - PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); + PUSHs(sv_2mortal(newSVpv(stashname, 0))); + PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0))); + PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop)))); if (!MAXARG) RETURN; - if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */ + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { + /* So is ccstack[dbcxix]. */ sv = NEWSV(49, 0); gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch); PUSHs(sv_2mortal(sv)); @@ -1463,7 +1533,7 @@ PP(pp_caller) PUSHs(&PL_sv_undef); } if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs - && PL_curcop->cop_stash == PL_debstash) + && CopSTASH_eq(PL_curcop, PL_debstash)) { AV *ary = cx->blk_sub.argarray; int off = AvARRAY(ary) - AvALLOC(ary); @@ -1499,7 +1569,7 @@ PP(pp_reset) tmps = ""; else tmps = POPpx; - sv_reset(tmps, PL_curcop->cop_stash); + sv_reset(tmps, CopSTASH(PL_curcop)); PUSHs(&PL_sv_yes); RETURN; } @@ -1547,7 +1617,7 @@ PP(pp_dbstate) PUSHSUB(cx); CvDEPTH(cv)++; (void)SvREFCNT_inc(cv); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); RETURNOP(CvSTART(cv)); } @@ -1566,6 +1636,10 @@ PP(pp_enteriter) register PERL_CONTEXT *cx; I32 gimme = GIMME_V; SV **svp; + U32 cxtype = CXt_LOOP; +#ifdef USE_ITHREADS + void *iterdata; +#endif ENTER; SAVETMPS; @@ -1582,26 +1656,42 @@ PP(pp_enteriter) if (PL_op->op_targ) { svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ SAVESPTR(*svp); +#ifdef USE_ITHREADS + iterdata = (void*)PL_op->op_targ; + cxtype |= CXp_PADVAR; +#endif } else { - svp = &GvSV((GV*)POPs); /* symbol table variable */ + GV *gv = (GV*)POPs; + svp = &GvSV(gv); /* symbol table variable */ SAVEGENERICSV(*svp); *svp = NEWSV(0,0); +#ifdef USE_ITHREADS + iterdata = (void*)gv; +#endif } ENTER; - PUSHBLOCK(cx, CXt_LOOP, SP); + PUSHBLOCK(cx, cxtype, SP); +#ifdef USE_ITHREADS + PUSHLOOP(cx, iterdata, MARK); +#else PUSHLOOP(cx, svp, MARK); +#endif if (PL_op->op_flags & OPf_STACKED) { cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { dPOPss; if (SvNIOKp(sv) || !SvPOKp(sv) || - (looks_like_number(sv) && *SvPVX(sv) != '0')) { + SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) || + (looks_like_number(sv) && *SvPVX(sv) != '0' && + looks_like_number((SV*)cx->blk_loop.iterary) && + *SvPVX(cx->blk_loop.iterary) != '0')) + { if (SvNV(sv) < IV_MIN || SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) - Perl_croak(aTHX_ "Range iterator outside integer range"); + DIE(aTHX_ "Range iterator outside integer range"); cx->blk_loop.iterix = SvIV(sv); cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary); } @@ -1638,7 +1728,6 @@ PP(pp_leaveloop) { djSP; register PERL_CONTEXT *cx; - struct block_loop cxloop; I32 gimme; SV **newsp; PMOP *newpm; @@ -1646,7 +1735,7 @@ PP(pp_leaveloop) POPBLOCK(cx,newpm); mark = newsp; - POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + newsp = PL_stack_base + cx->blk_loop.resetsp; TAINT_NOT; if (gimme == G_VOID) @@ -1666,7 +1755,7 @@ PP(pp_leaveloop) SP = newsp; PUTBACK; - POPLOOP2(); /* Stack values are safe: release loop vars ... */ + POPLOOP(cx); /* Stack values are safe: release loop vars ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; @@ -1680,15 +1769,17 @@ PP(pp_return) djSP; dMARK; I32 cxix; register PERL_CONTEXT *cx; - struct block_sub cxsub; bool popsub2 = FALSE; I32 gimme; SV **newsp; PMOP *newpm; I32 optype = 0; + SV *sv; if (PL_curstackinfo->si_type == PERLSI_SORT) { - if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) { + if (cxstack_ix == PL_sortcxix + || dopoptosub(cxstack_ix) <= PL_sortcxix) + { if (cxstack_ix > PL_sortcxix) dounwind(PL_sortcxix); AvARRAY(PL_curstack)[1] = *SP; @@ -1706,7 +1797,6 @@ PP(pp_return) POPBLOCK(cx,newpm); switch (CxTYPE(cx)) { case CXt_SUB: - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ popsub2 = TRUE; break; case CXt_EVAL: @@ -1723,6 +1813,9 @@ PP(pp_return) DIE(aTHX_ "%s did not return a true value", name); } break; + case CXt_FORMAT: + POPFORMAT(cx); + break; default: DIE(aTHX_ "panic: return"); } @@ -1731,7 +1824,7 @@ PP(pp_return) if (gimme == G_SCALAR) { if (MARK < SP) { if (popsub2) { - if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { if (SvTEMP(TOPs)) { *++newsp = SvREFCNT_inc(*SP); FREETMPS; @@ -1758,11 +1851,14 @@ PP(pp_return) /* Stack values are safe: */ if (popsub2) { - POPSUB2(); /* release CV and @_ ... */ + POPSUB(cx,sv); /* release CV and @_ ... */ } + else + sv = Nullsv; PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return pop_return(); } @@ -1771,20 +1867,19 @@ PP(pp_last) djSP; I32 cxix; register PERL_CONTEXT *cx; - struct block_loop cxloop; - struct block_sub cxsub; I32 pop2 = 0; I32 gimme; I32 optype; OP *nextop; SV **newsp; PMOP *newpm; - SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + SV **mark; + SV *sv = Nullsv; if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"last\" outside a block"); + DIE(aTHX_ "Can't \"last\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -1795,14 +1890,14 @@ PP(pp_last) dounwind(cxix); POPBLOCK(cx,newpm); + mark = newsp; switch (CxTYPE(cx)) { case CXt_LOOP: - POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ pop2 = CXt_LOOP; - nextop = cxloop.last_op->op_next; + newsp = PL_stack_base + cx->blk_loop.resetsp; + nextop = cx->blk_loop.last_op->op_next; break; case CXt_SUB: - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ pop2 = CXt_SUB; nextop = pop_return(); break; @@ -1810,6 +1905,10 @@ PP(pp_last) POPEVAL(cx); nextop = pop_return(); break; + case CXt_FORMAT: + POPFORMAT(cx); + nextop = pop_return(); + break; default: DIE(aTHX_ "panic: last"); } @@ -1835,16 +1934,17 @@ PP(pp_last) /* Stack values are safe: */ switch (pop2) { case CXt_LOOP: - POPLOOP2(); /* release loop vars ... */ + POPLOOP(cx); /* release loop vars ... */ LEAVE; break; case CXt_SUB: - POPSUB2(); /* release CV and @_ ... */ + POPSUB(cx,sv); /* release CV and @_ ... */ break; } PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return nextop; } @@ -1857,7 +1957,7 @@ PP(pp_next) if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"next\" outside a block"); + DIE(aTHX_ "Can't \"next\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -1867,10 +1967,17 @@ PP(pp_next) if (cxix < cxstack_ix) dounwind(cxix); - TOPBLOCK(cx); - oldsave = PL_scopestack[PL_scopestack_ix - 1]; - LEAVE_SCOPE(oldsave); - return cx->blk_loop.next_op; + cx = &cxstack[cxstack_ix]; + { + OP *nextop = cx->blk_loop.next_op; + /* clean scope, but only if there's no continue block */ + if (nextop == cUNOPx(cx->blk_loop.last_op)->op_first->op_next) { + TOPBLOCK(cx); + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + } + return nextop; + } } PP(pp_redo) @@ -1882,7 +1989,7 @@ PP(pp_redo) if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"redo\" outside a block"); + DIE(aTHX_ "Can't \"redo\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -1972,7 +2079,6 @@ PP(pp_goto) SV** mark; I32 items = 0; I32 oldsave; - int arg_was_real = 0; retry: if (!CvROOT(cv) && !CvXSUB(cv)) { @@ -2004,8 +2110,8 @@ PP(pp_goto) if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) DIE(aTHX_ "Can't goto subroutine from an eval-string"); mark = PL_stack_sp; - if (CxTYPE(cx) == CXt_SUB && - cx->blk_sub.hasargs) { /* put @_ back onto stack */ + if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) { + /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; items = AvFILLp(av) + 1; @@ -2017,11 +2123,14 @@ PP(pp_goto) SvREFCNT_dec(GvAV(PL_defgv)); GvAV(PL_defgv) = cx->blk_sub.savearray; #endif /* USE_THREADS */ + /* abandon @_ if it got reified */ if (AvREAL(av)) { - arg_was_real = 1; - AvREAL_off(av); /* so av_clear() won't clobber elts */ + (void)sv_2mortal((SV*)av); /* delay until return */ + av = newAV(); + av_extend(av, items-1); + AvFLAGS(av) = AVf_REIFY; + PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av); } - av_clear(av); } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ AV* av; @@ -2053,7 +2162,7 @@ PP(pp_goto) SP[1] = SP[0]; SP--; } - fp3 = (I32(*)(int,int,int)))CvXSUB(cv; + fp3 = (I32(*)(int,int,int))CvXSUB(cv); items = (*fp3)(CvXSUBANY(cv).any_i32, mark - PL_stack_base + 1, items); @@ -2097,9 +2206,10 @@ PP(pp_goto) AV *newpad = newAV(); SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); I32 ix = AvFILLp((AV*)svp[1]); + I32 names_fill = AvFILLp((AV*)svp[0]); svp = AvARRAY(svp[0]); for ( ;ix > 0; ix--) { - if (svp[ix] != &PL_sv_undef) { + if (names_fill >= ix && svp[ix] != &PL_sv_undef) { char *name = SvPVX(svp[ix]); if ((SvFLAGS(svp[ix]) & SVf_FAKE) || *name == '&') @@ -2118,6 +2228,9 @@ PP(pp_goto) SvPADMY_on(sv); } } + else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { + av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix])); + } else { av_store(newpad, ix, sv = NEWSV(0,0)); SvPADTMP_on(sv); @@ -2148,7 +2261,7 @@ PP(pp_goto) } } #endif /* USE_THREADS */ - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); #ifndef USE_THREADS if (cx->blk_sub.hasargs) @@ -2179,11 +2292,7 @@ PP(pp_goto) } Copy(mark,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; - /* preserve @_ nature */ - if (arg_was_real) { - AvREIFY_off(av); - AvREAL_on(av); - } + assert(!AvREAL(av)); while (items--) { if (*mark) SvTEMP_off(*mark); @@ -2257,8 +2366,9 @@ PP(pp_goto) break; } /* FALL THROUGH */ + case CXt_FORMAT: case CXt_NULL: - DIE(aTHX_ "Can't \"goto\" outside a block"); + DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); default: if (ix) DIE(aTHX_ "panic: goto"); @@ -2296,8 +2406,7 @@ PP(pp_goto) /* Eventually we may want to stack the needed arguments * for each op. For now, we punt on the hard ones. */ if (PL_op->op_type == OP_ENTERITER) - DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop", - label); + DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop"); CALL_FPTR(PL_op->op_ppaddr)(aTHX); } PL_op = oldop; @@ -2334,6 +2443,7 @@ PP(pp_exit) anum = 0; #endif } + PL_exit_flags |= PERL_EXIT_EXPECTED; my_exit(anum); PUSHs(&PL_sv_undef); RETURN; @@ -2419,18 +2529,20 @@ S_docatch(pTHX_ OP *o) dTHR; int ret; OP *oldop = PL_op; + volatile PERL_SI *cursi = PL_curstackinfo; + dJMPENV; #ifdef DEBUGGING assert(CATCH_GET == TRUE); #endif PL_op = o; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body)); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body)); switch (ret) { case 0: break; case 3: - if (PL_restartop) { + if (PL_restartop && cursi == PL_curstackinfo) { PL_op = PL_restartop; PL_restartop = 0; goto redo_body; @@ -2467,14 +2579,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) /* switch to eval mode */ if (PL_curcop == &PL_compiling) { - SAVESPTR(PL_compiling.cop_stash); - PL_compiling.cop_stash = PL_curstash; + SAVECOPSTASH(&PL_compiling); + CopSTASH_set(&PL_compiling, PL_curstash); } - SAVESPTR(PL_compiling.cop_filegv); - SAVEI16(PL_compiling.cop_line); + SAVECOPFILE(&PL_compiling); + SAVECOPLINE(&PL_compiling); sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - PL_compiling.cop_line = 1; + CopFILE_set(&PL_compiling, tmpbuf+2); + CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that @@ -2486,7 +2598,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) #ifdef OP_IN_REGISTER PL_opsave = op; #else - SAVEPPTR(PL_op); + SAVEVPTR(PL_op); #endif PL_hints = 0; @@ -2494,7 +2606,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) PL_op->op_type = OP_ENTEREVAL; PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); rop = doeval(G_SCALAR, startop); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2518,7 +2630,6 @@ S_doeval(pTHX_ int gimme, OP** startop) { dSP; OP *saveop = PL_op; - HV *newstash; CV *caller; AV* comppadlist; I32 i; @@ -2530,7 +2641,7 @@ S_doeval(pTHX_ int gimme, OP** startop) /* set up a scratch pad */ SAVEI32(PL_padix); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); SAVESPTR(PL_comppad); SAVESPTR(PL_comppad_name); SAVEI32(PL_comppad_name_fill); @@ -2542,7 +2653,7 @@ S_doeval(pTHX_ int gimme, OP** startop) PERL_CONTEXT *cx = &cxstack[i]; if (CxTYPE(cx) == CXt_EVAL) break; - else if (CxTYPE(cx) == CXt_SUB) { + else if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { caller = cx->blk_sub.cv; break; } @@ -2584,10 +2695,9 @@ S_doeval(pTHX_ int gimme, OP** startop) /* make sure we compile in the right package */ - newstash = PL_curcop->cop_stash; - if (PL_curstash != newstash) { + if (CopSTASH_ne(PL_curcop, PL_curstash)) { SAVESPTR(PL_curstash); - PL_curstash = newstash; + PL_curstash = CopSTASH(PL_curcop); } SAVESPTR(PL_beginav); PL_beginav = newAV(); @@ -2627,13 +2737,16 @@ S_doeval(pTHX_ int gimme, OP** startop) LEAVE; if (optype == OP_REQUIRE) { char* msg = SvPVx(ERRSV, n_a); - DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require"); - } else if (startop) { + DIE(aTHX_ "%sCompilation failed in require", + *msg ? msg : "Unknown error\n"); + } + else if (startop) { char* msg = SvPVx(ERRSV, n_a); POPBLOCK(cx,PL_curpm); POPEVAL(cx); - Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n")); + Perl_croak(aTHX_ "%sCompilation failed in regexp", + (*msg ? msg : "Unknown error\n")); } SvREFCNT_dec(PL_rs); PL_rs = SvREFCNT_inc(PL_nrs); @@ -2647,7 +2760,7 @@ S_doeval(pTHX_ int gimme, OP** startop) } SvREFCNT_dec(PL_rs); PL_rs = SvREFCNT_inc(PL_nrs); - PL_compiling.cop_line = 0; + CopLINE_set(&PL_compiling, 0); if (startop) { *startop = PL_eval_root; SvREFCNT_dec(CvOUTSIDE(PL_compcv)); @@ -2669,7 +2782,7 @@ S_doeval(pTHX_ int gimme, OP** startop) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -2741,10 +2854,54 @@ PP(pp_require) SV *filter_sub = 0; sv = POPs; - if (SvNIOKp(sv) && !SvPOKp(sv)) { - if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) - DIE(aTHX_ "Perl %s required--this is only version %s, stopped", - SvPV(sv,n_a),PL_patchlevel); + if (SvNIOKp(sv)) { + UV rev, ver, sver; + if (SvPOKp(sv) && SvUTF8(sv)) { /* require v5.6.1 */ + I32 len; + U8 *s = (U8*)SvPVX(sv); + U8 *end = (U8*)SvPVX(sv) + SvCUR(sv); + if (s < end) { + rev = utf8_to_uv(s, &len); + s += len; + if (s < end) { + ver = utf8_to_uv(s, &len); + s += len; + if (s < end) + sver = utf8_to_uv(s, &len); + else + sver = 0; + } + else + ver = 0; + } + else + rev = 0; + if (PERL_REVISION < rev + || (PERL_REVISION == rev + && (PERL_VERSION < ver + || (PERL_VERSION == ver + && PERL_SUBVERSION < sver)))) + { + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version " + "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION, + PERL_VERSION, PERL_SUBVERSION); + } + } + else if (!SvPOKp(sv)) { /* require 5.005_03 */ + NV n = SvNV(sv); + rev = (UV)n; + ver = (UV)((n-rev)*1000); + sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000); + + if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000) + + ((NV)PERL_SUBVERSION/(NV)1000000) + + 0.00000099 < SvNV(sv)) + { + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version " + "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION, + PERL_VERSION, PERL_SUBVERSION); + } + } RETPUSHYES; } name = SvPV(sv, len); @@ -2758,21 +2915,9 @@ PP(pp_require) /* prepare to compile file */ - if (*name == '/' || - (*name == '.' && - (name[1] == '/' || - (name[1] == '.' && name[2] == '/'))) -#ifdef DOSISH - || (name[0] && name[1] == ':') -#endif -#ifdef WIN32 - || (name[0] == '\\' && name[1] == '\\') /* UNC path */ -#endif -#ifdef VMS - || (strchr(name,':') || ((*name == '[' || *name == '<') && - (isALNUM(name[1]) || strchr("$-_]>",name[1])))) -#endif - ) + if (PERL_FILE_IS_ABSOLUTE(name) + || (*name == '.' && (name[1] == '/' || + (name[1] == '.' && name[2] == '/')))) { tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); @@ -2797,8 +2942,8 @@ PP(pp_require) loader = *av_fetch((AV *)SvRV(loader), 0, TRUE); } - Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s", - SvANY(loader), name); + Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s", + PTR2UV(SvANY(loader)), name); tryname = SvPVX(namesv); tryrsfp = 0; @@ -2916,8 +3061,8 @@ PP(pp_require) } } } - SAVESPTR(PL_compiling.cop_filegv); - PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); + SAVECOPFILE(&PL_compiling); + CopFILE_set(&PL_compiling, tryrsfp ? tryname : name); SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { @@ -2952,7 +3097,7 @@ PP(pp_require) /* Assume success here to prevent recursive requirement. */ (void)hv_store(GvHVn(PL_incgv), name, strlen(name), - newSVsv(GvSV(PL_compiling.cop_filegv)), 0 ); + newSVpv(CopFILE(&PL_compiling), 0), 0 ); ENTER; SAVETMPS; @@ -2961,11 +3106,9 @@ PP(pp_require) PL_rsfp_filters = Nullav; PL_rsfp = tryrsfp; - name = savepv(name); - SAVEFREEPV(name); SAVEHINTS(); PL_hints = 0; - SAVEPPTR(PL_compiling.cop_warnings); + SAVESPTR(PL_compiling.cop_warnings); if (PL_dowarn & G_WARN_ALL_ON) PL_compiling.cop_warnings = WARN_ALL ; else if (PL_dowarn & G_WARN_ALL_OFF) @@ -2984,10 +3127,10 @@ PP(pp_require) /* switch to eval mode */ push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name, PL_compiling.cop_filegv); + PUSHEVAL(cx, name, Nullgv); - SAVEI16(PL_compiling.cop_line); - PL_compiling.cop_line = 0; + SAVECOPLINE(&PL_compiling); + CopLINE_set(&PL_compiling, 0); PUTBACK; #ifdef USE_THREADS @@ -3027,10 +3170,10 @@ PP(pp_entereval) /* switch to eval mode */ - SAVESPTR(PL_compiling.cop_filegv); + SAVECOPFILE(&PL_compiling); sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - PL_compiling.cop_line = 1; + CopFILE_set(&PL_compiling, tmpbuf+2); + CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that @@ -3040,7 +3183,7 @@ PP(pp_entereval) SAVEDELETE(PL_defstash, safestr, strlen(safestr)); SAVEHINTS(); PL_hints = PL_op->op_targ; - SAVEPPTR(PL_compiling.cop_warnings); + SAVESPTR(PL_compiling.cop_warnings); if (!specialWARN(PL_compiling.cop_warnings)) { PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ; SAVEFREESV(PL_compiling.cop_warnings) ; @@ -3048,12 +3191,12 @@ PP(pp_entereval) push_return(PL_op->op_next); PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); /* prepare to compile string */ if (PERLDB_LINE && PL_curstash != PL_debstash) - save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr); + save_lines(CopFILEAV(&PL_compiling), PL_linestr); PUTBACK; #ifdef USE_THREADS MUTEX_LOCK(&PL_eval_mutex); @@ -3102,6 +3245,7 @@ PP(pp_leaveeval) MEXTEND(mark,0); *MARK = &PL_sv_undef; } + SP = MARK; } else { /* in case LEAVE wipes old return values */ @@ -4067,7 +4211,6 @@ S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare) #ifdef PERL_OBJECT -#define NO_XSLOCKS #undef this #define this pPerl #include "XSUB.h" @@ -4098,6 +4241,80 @@ sortcv(pTHXo_ SV *a, SV *b) return result; } +static I32 +sortcv_stacked(pTHXo_ SV *a, SV *b) +{ + dTHR; + I32 oldsaveix = PL_savestack_ix; + I32 oldscopeix = PL_scopestack_ix; + I32 result; + AV *av; + +#ifdef USE_THREADS + av = (AV*)PL_curpad[0]; +#else + av = GvAV(PL_defgv); +#endif + + if (AvMAX(av) < 1) { + SV** ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (AvMAX(av) < 1) { + AvMAX(av) = 1; + Renew(ary,2,SV*); + SvPVX(av) = (char*)ary; + } + } + AvFILLp(av) = 1; + + AvARRAY(av)[0] = a; + AvARRAY(av)[1] = b; + PL_stack_sp = PL_stack_base; + PL_op = PL_sortcop; + CALLRUNOPS(aTHX); + 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; +} + +static I32 +sortcv_xsub(pTHXo_ 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))(aTHXo_ 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; +} + static I32 sv_ncmp(pTHXo_ SV *a, SV *b)