X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c67ab8f24d0803db4a06be9c3701dc61df55b9ba..9fc05455cdaab916bba78bf0aec9b491fbb3e5dd:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index c7c562b..7ae8f3a 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -326,11 +326,11 @@ STATIC void S_pushav(pTHX_ AV* const av) { dSP; - const I32 maxarg = AvFILL(av) + 1; + const SSize_t maxarg = AvFILL(av) + 1; EXTEND(SP, maxarg); if (SvRMAGICAL(av)) { - U32 i; - for (i=0; i < (U32)maxarg; i++) { + PADOFFSET i; + for (i=0; i < (PADOFFSET)maxarg; i++) { SV ** const svp = av_fetch(av, i, FALSE); /* See note in pp_helem, and bug id #27839 */ SP[i+1] = svp @@ -339,7 +339,11 @@ S_pushav(pTHX_ AV* const av) } } else { - Copy(AvARRAY(av), SP+1, maxarg, SV*); + PADOFFSET i; + for (i=0; i < (PADOFFSET)maxarg; i++) { + SV * const sv = AvARRAY(av)[i]; + SP[i+1] = sv ? sv : &PL_sv_undef; + } } SP += maxarg; PUTBACK; @@ -920,7 +924,7 @@ PP(pp_rv2av) } else if (gimme == G_SCALAR) { dTARGET; - const I32 maxarg = AvFILL(av) + 1; + const SSize_t maxarg = AvFILL(av) + 1; SETi(maxarg); } } else { @@ -935,9 +939,8 @@ PP(pp_rv2av) && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied))) SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0))); else if (gimme == G_SCALAR) { - dTARGET; + dTARG; TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv)); - SPAGAIN; SETTARG; } } @@ -990,7 +993,7 @@ PP(pp_aassign) I32 gimme; HV *hash; - I32 i; + SSize_t i; int magic; U32 lval = 0; @@ -1055,8 +1058,8 @@ PP(pp_aassign) i = 0; while (relem <= lastrelem) { /* gobble up all the rest */ SV **didstore; - assert(*relem); - SvGETMAGIC(*relem); /* before newSV, in case it dies */ + if (*relem) + SvGETMAGIC(*relem); /* before newSV, in case it dies */ sv = newSV(0); sv_setsv_nomg(sv, *relem); *(relem++) = sv; @@ -1322,7 +1325,7 @@ PP(pp_match) PMOP *dynpm = pm; const char *s; const char *strend; - I32 curpos = 0; /* initial pos() or current $+[0] */ + SSize_t curpos = 0; /* initial pos() or current $+[0] */ I32 global; U8 r_flags = 0; const char *truebase; /* Start of string */ @@ -1332,6 +1335,7 @@ PP(pp_match) STRLEN len; const I32 oldsave = PL_savestack_ix; I32 had_zerolen = 0; + MAGIC *mg = NULL; if (PL_op->op_flags & OPf_STACKED) TARG = POPs; @@ -1378,16 +1382,18 @@ PP(pp_match) rx = PM_GETRE(pm); } - if (RX_MINLEN(rx) > (I32)len) { - DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n")); + if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) { + DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%" + UVuf" < %"IVdf")\n", + (UV)len, (IV)RX_MINLEN(rx))); goto nope; } /* get pos() if //g */ if (global) { - MAGIC * const mg = mg_find_mglob(TARG); + mg = mg_find_mglob(TARG); if (mg && mg->mg_len >= 0) { - curpos = mg->mg_len; + curpos = MgBYTEPOS(mg, TARG, truebase, len); /* last time pos() was set, it was zero-length match */ if (mg->mg_flags & MGf_MINMATCH) had_zerolen = 1; @@ -1398,6 +1404,7 @@ PP(pp_match) if ( RX_NPARENS(rx) || PL_sawampersand || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) + || (dynpm->op_pmflags & PMf_KEEPCOPY) ) #endif { @@ -1409,26 +1416,29 @@ PP(pp_match) if (! (global && gimme == G_ARRAY)) r_flags |= REXEC_COPY_SKIP_POST; }; +#ifdef PERL_SAWAMPERSAND + if (dynpm->op_pmflags & PMf_KEEPCOPY) + /* handle KEEPCOPY in pmop but not rx, eg $r=qr/a/; /$r/p */ + r_flags &= ~(REXEC_COPY_SKIP_PRE|REXEC_COPY_SKIP_POST); +#endif s = truebase; play_it_again: - if (global) { + if (global) s = truebase + curpos; - } if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, had_zerolen, TARG, NULL, r_flags)) goto nope; PL_curpm = pm; - if (dynpm->op_pmflags & PMf_ONCE) { + if (dynpm->op_pmflags & PMf_ONCE) #ifdef USE_ITHREADS SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]); #else dynpm->op_pmflags |= PMf_USED; #endif - } if (rxtainted) RX_MATCH_TAINTED_on(rx); @@ -1437,18 +1447,13 @@ PP(pp_match) /* update pos */ if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) { - MAGIC *mg = mg_find_mglob(TARG); - if (!mg) { + if (!mg) mg = sv_magicext_mglob(TARG); - } - assert(RX_OFFS(rx)[0].start != -1); /* XXX get rid of next line? */ - if (RX_OFFS(rx)[0].start != -1) { - mg->mg_len = RX_OFFS(rx)[0].end; - if (RX_ZERO_LEN(rx)) - mg->mg_flags |= MGf_MINMATCH; - else - mg->mg_flags &= ~MGf_MINMATCH; - } + MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end); + if (RX_ZERO_LEN(rx)) + mg->mg_flags |= MGf_MINMATCH; + else + mg->mg_flags &= ~MGf_MINMATCH; } if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) { @@ -1495,9 +1500,10 @@ PP(pp_match) nope: if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) { - MAGIC* const mg = mg_find_mglob(TARG); - if (mg) - mg->mg_len = -1; + if (!mg) + mg = mg_find_mglob(TARG); + if (mg) + mg->mg_len = -1; } LEAVE_SCOPE(oldsave); if (gimme == G_ARRAY) @@ -1562,14 +1568,10 @@ Perl_do_readline(pTHX) } if (!fp) { if ((!io || !(IoFLAGS(io) & IOf_START)) - && ckWARN2(WARN_GLOB, WARN_CLOSED)) + && ckWARN(WARN_CLOSED) + && type != OP_GLOB) { - if (type == OP_GLOB) - Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB), - "glob failed (can't start child: %s)", - Strerror(errno)); - else - report_evil_fh(PL_last_in_gv); + report_evil_fh(PL_last_in_gv); } if (gimme == G_SCALAR) { /* undef TARG, and push that undefined value */ @@ -1911,19 +1913,12 @@ PP(pp_iter) SvREFCNT_inc_simple_void_NN(sv); } } + else if (!av_is_stack) { + sv = newSVavdefelem(av, ix, 0); + } else sv = &PL_sv_undef; - if (!av_is_stack && sv == &PL_sv_undef) { - SV *lv = newSV_type(SVt_PVLV); - LvTYPE(lv) = 'y'; - sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0); - LvTARG(lv) = SvREFCNT_inc_simple(av); - LvTARGOFF(lv) = ix; - LvTARGLEN(lv) = (STRLEN)UV_MAX; - sv = lv; - } - oldsv = *itersvp; *itersvp = sv; SvREFCNT_dec(oldsv); @@ -2018,7 +2013,6 @@ PP(pp_subst) STRLEN clen; I32 iters = 0; I32 maxiters; - I32 i; bool once; U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits. See "how taint works" above */ @@ -2058,9 +2052,6 @@ PP(pp_subst) sv_force_normal_flags(TARG,0); #endif if (!(rpm->op_pmflags & PMf_NONDESTRUCT) -#ifdef PERL_ANY_COW - && !is_cow -#endif && (SvREADONLY(TARG) || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) || SvTYPE(TARG) > SVt_PVLV) @@ -2109,6 +2100,7 @@ PP(pp_subst) r_flags = ( RX_NPARENS(rx) || PL_sawampersand || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) + || (rpm->op_pmflags & PMf_KEEPCOPY) ) ? REXEC_COPY_STR : 0; @@ -2157,7 +2149,10 @@ PP(pp_subst) && !is_cow #endif && (I32)clen <= RX_MINLENRET(rx) - && (once || !(r_flags & REXEC_COPY_STR)) + && ( once + || !(r_flags & REXEC_COPY_STR) + || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN)) + ) && !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST) && (!doutf8 || SvUTF8(TARG)) && !(rpm->op_pmflags & PMf_NONDESTRUCT)) @@ -2186,6 +2181,7 @@ PP(pp_subst) d = orig + RX_OFFS(rx)[0].end; s = orig; if (m - s > strend - d) { /* faster to shorten from end */ + I32 i; if (clen) { Copy(c, m, clen, char); m += clen; @@ -2198,21 +2194,14 @@ PP(pp_subst) *m = '\0'; SvCUR_set(TARG, m - s); } - else if ((i = m - s)) { /* faster from front */ + else { /* faster from front */ + I32 i = m - s; d -= clen; - m = d; - Move(s, d - i, i, char); + if (i > 0) + Move(s, d - i, i, char); sv_chop(TARG, d-i); if (clen) - Copy(c, m, clen, char); - } - else if (clen) { - d -= clen; - sv_chop(TARG, d); - Copy(c, d, clen, char); - } - else { - sv_chop(TARG, d); + Copy(c, d, clen, char); } SPAGAIN; PUSHs(&PL_sv_yes); @@ -2221,6 +2210,7 @@ PP(pp_subst) char *d, *m; d = s = RX_OFFS(rx)[0].start + orig; do { + I32 i; if (iters++ > maxiters) DIE(aTHX_ "Substitution loop"); if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ @@ -2236,12 +2226,12 @@ PP(pp_subst) d += clen; } s = RX_OFFS(rx)[0].end + orig; - } while (CALLREGEXEC(rx, s, strend, orig, s == m, + } while (CALLREGEXEC(rx, s, strend, orig, + s == m, /* don't match same null twice */ TARG, NULL, - /* don't match same null twice */ - REXEC_NOT_FIRST|REXEC_IGNOREPOS)); + REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW)); if (s != d) { - i = strend - s; + I32 i = strend - s; SvCUR_set(TARG, d - SvPVX_const(TARG) + i); Move(s, d, i+1, char); /* include the NUL */ } @@ -2289,7 +2279,6 @@ PP(pp_subst) PUSHSUBST(cx); RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot); } - r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST; first = TRUE; do { if (iters++ > maxiters) @@ -2328,7 +2317,8 @@ PP(pp_subst) if (once) break; } while (CALLREGEXEC(rx, s, strend, orig, s == m, - TARG, NULL, r_flags)); + TARG, NULL, + REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW)); sv_catpvn_nomg_maybeutf8(dstr, s, strend - s, DO_UTF8(TARG)); if (rpm->op_pmflags & PMf_NONDESTRUCT) { @@ -2508,8 +2498,8 @@ PP(pp_leavesub) PUTBACK; LEAVE; - cxstack_ix--; POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ + cxstack_ix--; PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); @@ -2631,7 +2621,7 @@ try_autoload: PL_curcopdb = PL_curcop; if (CvLVALUE(cv)) { /* check for lsub that handles lvalue subroutines */ - cv = GvCV(gv_HVadd(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVHV))); + cv = GvCV(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVCV)); /* if lsub not found then fall back to DB::sub */ if (!cv) cv = GvCV(PL_DBsub); } else { @@ -2645,7 +2635,7 @@ try_autoload: if (!(CvISXSUB(cv))) { /* This path taken at least 75% of the time */ dMARK; - I32 items = SP - MARK; + SSize_t items = SP - MARK; PADLIST * const padlist = CvPADLIST(cv); PUSHBLOCK(cx, CXt_SUB, MARK); PUSHSUB(cx); @@ -2708,7 +2698,7 @@ try_autoload: RETURNOP(CvSTART(cv)); } else { - I32 markix = TOPMARK; + SSize_t markix = TOPMARK; SAVETMPS; PUTBACK; @@ -2719,21 +2709,44 @@ try_autoload: !CvLVALUE(cv)) DIE(aTHX_ "Can't modify non-lvalue subroutine call"); - if (!hasargs) { + if (!hasargs && GvAV(PL_defgv)) { /* Need to copy @_ to stack. Alternative may be to * switch stack to @_, and copy return values * back. This would allow popping @_ in XSUB, e.g.. XXXX */ AV * const av = GvAV(PL_defgv); - const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */ + const SSize_t items = AvFILL(av) + 1; if (items) { + SSize_t i = 0; + const bool m = cBOOL(SvRMAGICAL(av)); /* Mark is at the end of the stack. */ EXTEND(SP, items); - Copy(AvARRAY(av), SP + 1, items, SV*); + for (; i < items; ++i) + { + SV *sv; + if (m) { + SV ** const svp = av_fetch(av, i, 0); + sv = svp ? *svp : NULL; + } + else sv = AvARRAY(av)[i]; + if (sv) SP[i+1] = sv; + else { + SP[i+1] = newSVavdefelem(av, i, 1); + } + } SP += items; PUTBACK ; } } + else { + SV **mark = PL_stack_base + markix; + SSize_t items = SP - mark; + while (items--) { + mark++; + if (*mark && SvPADTMP(*mark) && !IS_PADGV(*mark)) + *mark = sv_mortalcopy(*mark); + } + } /* We assume first XSUB in &DB::sub is the called one. */ if (PL_curcopdb) { SAVEVPTR(PL_curcop); @@ -2789,7 +2802,7 @@ PP(pp_aelem) IV elem = SvIV(elemsv); AV *const av = MUTABLE_AV(POPs); const U32 lval = PL_op->op_flags & OPf_MOD || LVRET; - const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av)); + const U32 defer = PL_op->op_private & OPpLVAL_DEFER; const bool localizing = PL_op->op_private & OPpLVAL_INTRO; bool preeminent = TRUE; SV *sv; @@ -2828,18 +2841,17 @@ PP(pp_aelem) MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend); } #endif - if (!svp || *svp == &PL_sv_undef) { - SV* lv; + if (!svp || !*svp) { + IV len; if (!defer) DIE(aTHX_ PL_no_aelem, elem); - lv = sv_newmortal(); - sv_upgrade(lv, SVt_PVLV); - LvTYPE(lv) = 'y'; - sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0); - LvTARG(lv) = SvREFCNT_inc_simple(av); - LvTARGOFF(lv) = elem; - LvTARGLEN(lv) = 1; - PUSHs(lv); + len = av_len(av); + mPUSHs(newSVavdefelem(av, + /* Resolve a negative index now, unless it points before the + beginning of the array, in which case record it for error + reporting in magic_setdefelem. */ + elem < 0 && len + elem >= 0 ? len + elem : elem, + 1)); RETURN; } if (localizing) {