X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c73f612f8535d5db75d096a430a7938ce1c28a10..2ac6acbfdb0279ee04042bba82091927148060a4:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index 3db6f5d..7c98c90 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -360,7 +360,6 @@ PP(pp_padrange) dSP; PADOFFSET base = PL_op->op_targ; int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK; - int i; if (PL_op->op_flags & OPf_SPECIAL) { /* fake the RHS of my ($x,$y,..) = @_ */ PUSHMARK(SP); @@ -370,6 +369,8 @@ PP(pp_padrange) /* note, this is only skipped for compile-time-known void cxt */ if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) { + int i; + EXTEND(SP, count); PUSHMARK(SP); for (i = 0; i > (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == (Size_t)base); @@ -1039,7 +1042,7 @@ PP(pp_rv2av) || ( PL_op->op_private & OPpMAYBE_TRUEBOOL && block_gimme() == G_VOID )) && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied))) - SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0))); + SETs(HvUSEDKEYS(MUTABLE_HV(sv)) ? &PL_sv_yes : &PL_sv_no); else if (gimme == G_SCALAR) { dTARG; TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv)); @@ -1163,8 +1166,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem, lcount = -1; lelem--; /* no need to unmark this element */ } - else if (!(do_rc1 && SvREFCNT(svl) == 1) && svl != &PL_sv_undef) { - assert(!SvIMMORTAL(svl)); + else if (!(do_rc1 && SvREFCNT(svl) == 1) && !SvIMMORTAL(svl)) { SvFLAGS(svl) |= SVf_BREAK; marked = TRUE; } @@ -1183,6 +1185,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem, assert(svr); if (UNLIKELY(SvFLAGS(svr) & (SVf_BREAK|SVs_GMG) || copy_all)) { + U32 brk = (SvFLAGS(svr) & SVf_BREAK); #ifdef DEBUGGING if (fake) { @@ -1218,7 +1221,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem, /* ... but restore afterwards in case it's needed again, * e.g. ($a,$b,$c) = (1,$a,$a) */ - SvFLAGS(svr) |= SVf_BREAK; + SvFLAGS(svr) |= brk; } if (!lcount) @@ -1456,7 +1459,7 @@ PP(pp_aassign) tmps_base -= nelems; - if (SvRMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) { + if (SvMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) { /* for arrays we can't cheat with, use the official API */ av_extend(ary, nelems - 1); for (i = 0; i < nelems; i++) { @@ -1709,6 +1712,8 @@ PP(pp_aassign) default: if (!SvIMMORTAL(lsv)) { + SV *ref; + if (UNLIKELY( SvTEMP(lsv) && !SvSMAGICAL(lsv) && SvREFCNT(lsv) == 1 && (!isGV_with_GP(lsv) || SvFAKE(lsv)) && ckWARN(WARN_MISC) @@ -1717,6 +1722,24 @@ PP(pp_aassign) packWARN(WARN_MISC), "Useless assignment to a temporary" ); + + /* avoid freeing $$lsv if it might be needed for further + * elements, e.g. ($ref, $foo) = (1, $$ref) */ + if ( SvROK(lsv) + && ( ((ref = SvRV(lsv)), SvREFCNT(ref)) == 1) + && lelem <= lastlelem + ) { + SSize_t ix; + SvREFCNT_inc_simple_void_NN(ref); + /* an unrolled sv_2mortal */ + ix = ++PL_tmps_ix; + if (UNLIKELY(ix >= PL_tmps_max)) + /* speculatively grow enough to cover other + * possible refs */ + ix = tmps_grow_p(ix + (lastlelem - lelem)); + PL_tmps_stack[ix] = ref; + } + sv_setsv(lsv, *relem); *relem = lsv; SvSETMAGIC(lsv); @@ -1757,7 +1780,7 @@ PP(pp_aassign) default: if (!SvIMMORTAL(lsv)) { - sv_setsv(lsv, &PL_sv_undef); + sv_set_undef(lsv); SvSETMAGIC(lsv); *relem++ = lsv; } @@ -1984,7 +2007,7 @@ PP(pp_match) 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", + UVuf " < %" IVdf ")\n", (UV)len, (IV)RX_MINLEN(rx))); goto nope; } @@ -2080,7 +2103,7 @@ PP(pp_match) if (UNLIKELY(RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 || len < 0 || len > strend - s)) DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, " - "start=%ld, end=%ld, s=%p, strend=%p, len=%"UVuf, + "start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf, (long) i, (long) RX_OFFS(rx)[i].start, (long)RX_OFFS(rx)[i].end, s, strend, (UV) len); sv_setpvn(*SP, s, len); @@ -2538,7 +2561,7 @@ PP(pp_multideref) if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%"SVf"\" as array index", + "Use of reference \"%" SVf "\" as array index", SVfARG(elemsv)); /* the only time that S_find_uninit_var() needs this * is to determine which index value triggered the @@ -2864,6 +2887,8 @@ PP(pp_iter) It has SvPVX of "" and SvCUR of 0, which is what we want. */ STRLEN maxlen = 0; const char *max = SvPV_const(end, maxlen); + if (DO_UTF8(end) && IN_UNI_8_BIT) + maxlen = sv_len_utf8_nomg(end); if (UNLIKELY(SvNIOK(cur) || SvCUR(cur) > maxlen)) goto retno; @@ -4008,7 +4033,7 @@ PP(pp_entersub) /* anonymous or undef'd function leaves us no recourse */ if (CvLEXICAL(cv) && CvHASGV(cv)) - DIE(aTHX_ "Undefined subroutine &%"SVf" called", + DIE(aTHX_ "Undefined subroutine &%" SVf " called", SVfARG(cv_name(cv, NULL, 0))); if (CvANON(cv) || !CvHASGV(cv)) { DIE(aTHX_ "Undefined subroutine called"); @@ -4031,7 +4056,7 @@ PP(pp_entersub) if (!cv) { sub_name = sv_newmortal(); gv_efullname3(sub_name, gv, NULL); - DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name)); + DIE(aTHX_ "Undefined subroutine &%" SVf " called", SVfARG(sub_name)); } } @@ -4109,8 +4134,8 @@ PP(pp_entersub) items = SP - MARK; if (UNLIKELY(items - 1 > AvMAX(av))) { SV **ary = AvALLOC(av); - AvMAX(av) = items - 1; Renew(ary, items, SV*); + AvMAX(av) = items - 1; AvALLOC(av) = ary; AvARRAY(av) = ary; } @@ -4120,7 +4145,7 @@ PP(pp_entersub) } if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && !CvLVALUE(cv))) - DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf, + DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf, SVfARG(cv_name(cv, NULL, 0))); /* warning must come *after* we fully set up the context * stuff so that __WARN__ handlers can safely dounwind() @@ -4147,7 +4172,7 @@ PP(pp_entersub) & CX_PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub) ) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && !CvLVALUE(cv))) - DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf, + DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf, SVfARG(cv_name(cv, NULL, 0))); if (UNLIKELY(!(PL_op->op_flags & OPf_STACKED) && GvAV(PL_defgv))) { @@ -4226,7 +4251,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) if (CvANON(cv)) Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { - Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"", + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"", SVfARG(cv_name(cv,NULL,0))); } } @@ -4268,7 +4293,7 @@ PP(pp_aelem) if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%"SVf"\" as array index", + "Use of reference \"%" SVf "\" as array index", SVfARG(elemsv)); if (UNLIKELY(SvTYPE(av) != SVt_PVAV)) RETPUSHUNDEF; @@ -4373,7 +4398,7 @@ S_opmethod_stash(pTHX_ SV* meth) HV* stash; SV* const sv = PL_stack_base + TOPMARK == PL_stack_sp - ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a " + ? (Perl_croak(aTHX_ "Can't call method \"%" SVf "\" without a " "package or object reference", SVfARG(meth)), (SV *)NULL) : *(PL_stack_base + TOPMARK + 1); @@ -4382,7 +4407,7 @@ S_opmethod_stash(pTHX_ SV* meth) if (UNLIKELY(!sv)) undefined: - Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value", + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on an undefined value", SVfARG(meth)); if (UNLIKELY(SvGMAGICAL(sv))) mg_get(sv); @@ -4396,7 +4421,7 @@ S_opmethod_stash(pTHX_ SV* meth) else if (!SvOK(sv)) goto undefined; else if (isGV_with_GP(sv)) { if (!GvIO(sv)) - Perl_croak(aTHX_ "Can't call method \"%"SVf"\" " + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " "without a package or object reference", SVfARG(meth)); ob = sv; @@ -4424,7 +4449,7 @@ S_opmethod_stash(pTHX_ SV* meth) /* this isn't the name of a filehandle either */ if (!packlen) { - Perl_croak(aTHX_ "Can't call method \"%"SVf"\" " + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " "without a package or object reference", SVfARG(meth)); } @@ -4443,8 +4468,8 @@ S_opmethod_stash(pTHX_ SV* meth) && (ob = MUTABLE_SV(GvIO((const GV *)ob))) && SvOBJECT(ob)))) { - Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference", - SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa")) + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on unblessed reference", + SVfARG((SvPOK(meth) && SvPVX(meth) == PL_isa_DOES) ? newSVpvs_flags("DOES", SVs_TEMP) : meth)); }