X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/60779a30f61297ad86e175f686b7bc697c7b8e51..570afc52205374eff1efd9d307ca6ece2719dd2f:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index ae88d83..333bcc8 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -39,7 +39,6 @@ PP(pp_const) { - dVAR; dSP; XPUSHs(cSVOP_sv); RETURN; @@ -47,7 +46,6 @@ PP(pp_const) PP(pp_nextstate) { - dVAR; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -58,10 +56,9 @@ PP(pp_nextstate) PP(pp_gvsv) { - dVAR; dSP; EXTEND(SP,1); - if (PL_op->op_private & OPpLVAL_INTRO) + if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) PUSHs(save_scalar(cGVOP_gv)); else PUSHs(GvSVn(cGVOP_gv)); @@ -70,21 +67,19 @@ PP(pp_gvsv) PP(pp_null) { - dVAR; return NORMAL; } /* This is sometimes called directly by pp_coreargs and pp_grepstart. */ PP(pp_pushmark) { - dVAR; PUSHMARK(PL_stack_sp); return NORMAL; } PP(pp_stringify) { - dVAR; dSP; dTARGET; + dSP; dTARGET; SV * const sv = TOPs; SETs(TARG); sv_copypv(TARG, sv); @@ -95,14 +90,13 @@ PP(pp_stringify) PP(pp_gv) { - dVAR; dSP; + dSP; XPUSHs(MUTABLE_SV(cGVOP_gv)); RETURN; } PP(pp_and) { - dVAR; PERL_ASYNC_CHECK(); { /* SP is not used to remove a variable that is saved across the @@ -123,7 +117,7 @@ PP(pp_and) PP(pp_sassign) { - dVAR; dSP; + dSP; /* sassign keeps its args in the optree traditionally backwards. So we pop them differently. */ @@ -133,9 +127,10 @@ PP(pp_sassign) SV * const temp = left; left = right; right = temp; } - if (TAINTING_get && TAINT_get && !SvTAINTED(right)) + if (TAINTING_get && UNLIKELY(TAINT_get) && !SvTAINTED(right)) TAINT_NOT; - if (PL_op->op_private & OPpASSIGN_CV_TO_GV) { + if (UNLIKELY(PL_op->op_private & OPpASSIGN_CV_TO_GV)) { + /* *foo =\&bar */ SV * const cv = SvRV(right); const U32 cv_type = SvTYPE(cv); const bool is_gv = isGV_with_GP(left); @@ -214,7 +209,7 @@ PP(pp_sassign) } if ( - SvTEMP(left) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 && + UNLIKELY(SvTEMP(left)) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 && (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC) ) Perl_warner(aTHX_ @@ -227,7 +222,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - dVAR; dSP; + dSP; PERL_ASYNC_CHECK(); if (SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other); @@ -237,7 +232,6 @@ PP(pp_cond_expr) PP(pp_unstack) { - dVAR; PERL_ASYNC_CHECK(); TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -251,7 +245,7 @@ PP(pp_unstack) PP(pp_concat) { - dVAR; dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign); + dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign); { dPOPTOPssrl; bool lbyte; @@ -330,7 +324,7 @@ S_pushav(pTHX_ AV* const av) dSP; const SSize_t maxarg = AvFILL(av) + 1; EXTEND(SP, maxarg); - if (SvRMAGICAL(av)) { + if (UNLIKELY(SvRMAGICAL(av))) { PADOFFSET i; for (i=0; i < (PADOFFSET)maxarg; i++) { SV ** const svp = av_fetch(av, i, FALSE); @@ -344,7 +338,7 @@ S_pushav(pTHX_ AV* const av) PADOFFSET i; for (i=0; i < (PADOFFSET)maxarg; i++) { SV * const sv = AvARRAY(av)[i]; - SP[i+1] = sv ? sv : &PL_sv_undef; + SP[i+1] = LIKELY(sv) ? sv : &PL_sv_undef; } } SP += maxarg; @@ -356,7 +350,7 @@ S_pushav(pTHX_ AV* const av) PP(pp_padrange) { - dVAR; dSP; + dSP; PADOFFSET base = PL_op->op_targ; int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK; int i; @@ -397,7 +391,7 @@ PP(pp_padrange) PP(pp_padsv) { - dVAR; dSP; + dSP; EXTEND(SP, 1); { OP * const op = PL_op; @@ -427,7 +421,6 @@ PP(pp_padsv) PP(pp_readline) { - dVAR; dSP; if (TOPs) { SvGETMAGIC(TOPs); @@ -451,7 +444,7 @@ PP(pp_readline) PP(pp_eq) { - dVAR; dSP; + dSP; SV *left, *right; tryAMAGICbin_MG(eq_amg, AMGf_set|AMGf_numeric); @@ -467,12 +460,12 @@ PP(pp_eq) PP(pp_preinc) { - dVAR; dSP; + dSP; const bool inc = PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC; - if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))) + if (UNLIKELY(SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))) Perl_croak_no_modify(); - if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) + if (LIKELY(!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) { SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); @@ -487,7 +480,7 @@ PP(pp_preinc) PP(pp_or) { - dVAR; dSP; + dSP; PERL_ASYNC_CHECK(); if (SvTRUE(TOPs)) RETURN; @@ -500,7 +493,7 @@ PP(pp_or) PP(pp_defined) { - dVAR; dSP; + dSP; SV* sv; bool defined; const int op_type = PL_op->op_type; @@ -509,7 +502,7 @@ PP(pp_defined) if (is_dor) { PERL_ASYNC_CHECK(); sv = TOPs; - if (!sv || !SvANY(sv)) { + if (UNLIKELY(!sv || !SvANY(sv))) { if (op_type == OP_DOR) --SP; RETURNOP(cLOGOP->op_other); @@ -518,7 +511,7 @@ PP(pp_defined) else { /* OP_DEFINED */ sv = POPs; - if (!sv || !SvANY(sv)) + if (UNLIKELY(!sv || !SvANY(sv))) RETPUSHNO; } @@ -558,7 +551,7 @@ PP(pp_defined) PP(pp_add) { - dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr; + dSP; dATARGET; bool useleft; SV *svl, *svr; tryAMAGICbin_MG(add_amg, AMGf_assign|AMGf_numeric); svr = TOPs; svl = TOPm1s; @@ -723,12 +716,16 @@ PP(pp_add) PP(pp_aelemfast) { - dVAR; dSP; + dSP; AV * const av = PL_op->op_type == OP_AELEMFAST_LEX ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv); const U32 lval = PL_op->op_flags & OPf_MOD; - SV** const svp = av_fetch(av, PL_op->op_private, lval); + SV** const svp = av_fetch(av, (I8)PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); + + if (UNLIKELY(!svp && lval)) + DIE(aTHX_ PL_no_aelem, (int)(I8)PL_op->op_private); + EXTEND(SP, 1); if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */ mg_get(sv); @@ -738,7 +735,7 @@ PP(pp_aelemfast) PP(pp_join) { - dVAR; dSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; MARK++; do_join(TARG, *MARK, MARK, SP); SP = MARK; @@ -748,7 +745,7 @@ PP(pp_join) PP(pp_pushre) { - dVAR; dSP; + dSP; #ifdef DEBUGGING /* * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs @@ -769,7 +766,7 @@ PP(pp_pushre) PP(pp_print) { - dVAR; dSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; PerlIO *fp; MAGIC *mg; GV * const gv @@ -863,7 +860,7 @@ PP(pp_print) PP(pp_rv2av) { - dVAR; dSP; dTOPss; + dSP; dTOPss; const I32 gimme = GIMME_V; static const char an_array[] = "an ARRAY"; static const char a_hash[] = "a HASH"; @@ -872,18 +869,18 @@ PP(pp_rv2av) SvGETMAGIC(sv); if (SvROK(sv)) { - if (SvAMAGIC(sv)) { + if (UNLIKELY(SvAMAGIC(sv))) { sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg); } sv = SvRV(sv); - if (SvTYPE(sv) != type) + if (UNLIKELY(SvTYPE(sv) != type)) /* diag_listed_as: Not an ARRAY reference */ DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash); - else if (PL_op->op_flags & OPf_MOD - && PL_op->op_private & OPpLVAL_INTRO) + else if (UNLIKELY(PL_op->op_flags & OPf_MOD + && PL_op->op_private & OPpLVAL_INTRO)) Perl_croak(aTHX_ "%s", PL_no_localize_ref); } - else if (SvTYPE(sv) != type) { + else if (UNLIKELY(SvTYPE(sv) != type)) { GV *gv; if (!isGV_with_GP(sv)) { @@ -903,7 +900,7 @@ PP(pp_rv2av) SETs(sv); RETURN; } - else if (PL_op->op_private & OPpMAYBE_LVSUB) { + else if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { const I32 flags = is_lvalue_sub(); if (flags && !(flags & OPpENTERSUB_INARGS)) { if (gimme != G_ARRAY) @@ -957,8 +954,6 @@ PP(pp_rv2av) STATIC void S_do_oddball(pTHX_ SV **oddkey, SV **firstkey) { - dVAR; - PERL_ARGS_ASSERT_DO_ODDBALL; if (*oddkey) { @@ -1022,13 +1017,13 @@ PP(pp_aassign) ) { EXTEND_MORTAL(lastrelem - firstrelem + 1); for (relem = firstrelem; relem <= lastrelem; relem++) { - if ((sv = *relem)) { + if (LIKELY((sv = *relem))) { TAINT_NOT; /* Each item is independent */ /* Dear TODO test in t/op/sort.t, I love you. (It's relying on a panic, not a "semi-panic" from newSVsv() and then an assertion failure below.) */ - if (SvIS_FREED(sv)) { + if (UNLIKELY(SvIS_FREED(sv))) { Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p", (void*)sv); } @@ -1046,7 +1041,7 @@ PP(pp_aassign) ary = NULL; hash = NULL; - while (lelem <= lastlelem) { + while (LIKELY(lelem <= lastlelem)) { TAINT_NOT; /* Each item stands on its own, taintwise. */ sv = *lelem++; switch (SvTYPE(sv)) { @@ -1060,7 +1055,7 @@ PP(pp_aassign) i = 0; while (relem <= lastrelem) { /* gobble up all the rest */ SV **didstore; - if (*relem) + if (LIKELY(*relem)) SvGETMAGIC(*relem); /* before newSV, in case it dies */ sv = newSV(0); sv_setsv_nomg(sv, *relem); @@ -1074,7 +1069,7 @@ PP(pp_aassign) } TAINT_NOT; } - if (PL_delaymagic & DM_ARRAY_ISA) + if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA)) SvSETMAGIC(MUTABLE_SV(ary)); LEAVE; break; @@ -1089,7 +1084,7 @@ PP(pp_aassign) magic = SvMAGICAL(hash) != 0; odd = ((lastrelem - firsthashrelem)&1)? 0 : 1; - if ( odd ) { + if (UNLIKELY(odd)) { do_oddball(lastrelem, firsthashrelem); /* we have firstlelem to reuse, it's not needed anymore */ @@ -1099,7 +1094,7 @@ PP(pp_aassign) ENTER; SAVEFREESV(SvREFCNT_inc_simple_NN(sv)); hv_clear(hash); - while (relem < lastrelem+odd) { /* gobble up all the rest */ + while (LIKELY(relem < lastrelem+odd)) { /* gobble up all the rest */ HE *didstore; assert(*relem); /* Copy the key if aassign is called in lvalue context, @@ -1159,10 +1154,10 @@ PP(pp_aassign) break; } if (relem <= lastrelem) { - if ( + if (UNLIKELY( SvTEMP(sv) && !SvSMAGICAL(sv) && SvREFCNT(sv) == 1 && (!isGV_with_GP(sv) || SvFAKE(sv)) && ckWARN(WARN_MISC) - ) + )) Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless assignment to a temporary" @@ -1176,83 +1171,82 @@ PP(pp_aassign) break; } } - if (PL_delaymagic & ~DM_DELAY) { - int rc = 0; + if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) { /* Will be used to set PL_tainting below */ Uid_t tmp_uid = PerlProc_getuid(); Uid_t tmp_euid = PerlProc_geteuid(); Gid_t tmp_gid = PerlProc_getgid(); Gid_t tmp_egid = PerlProc_getegid(); + /* XXX $> et al currently silently ignore failures */ if (PL_delaymagic & DM_UID) { #ifdef HAS_SETRESUID - rc = setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1, - (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1, - (Uid_t)-1); + PERL_UNUSED_RESULT( + setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1, + (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1, + (Uid_t)-1)); #else # ifdef HAS_SETREUID - rc = setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1, - (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1); + PERL_UNUSED_RESULT( + setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1, + (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1)); # else # ifdef HAS_SETRUID if ((PL_delaymagic & DM_UID) == DM_RUID) { - rc = setruid(PL_delaymagic_uid); + PERL_UNUSED_RESULT(setruid(PL_delaymagic_uid)); PL_delaymagic &= ~DM_RUID; } # endif /* HAS_SETRUID */ # ifdef HAS_SETEUID if ((PL_delaymagic & DM_UID) == DM_EUID) { - rc = seteuid(PL_delaymagic_euid); + PERL_UNUSED_RESULT(seteuid(PL_delaymagic_euid)); PL_delaymagic &= ~DM_EUID; } # endif /* HAS_SETEUID */ if (PL_delaymagic & DM_UID) { if (PL_delaymagic_uid != PL_delaymagic_euid) DIE(aTHX_ "No setreuid available"); - rc = PerlProc_setuid(PL_delaymagic_uid); + PERL_UNUSED_RESULT(PerlProc_setuid(PL_delaymagic_uid)); } # endif /* HAS_SETREUID */ #endif /* HAS_SETRESUID */ - /* XXX $> et al currently silently ignore failures */ - PERL_UNUSED_VAR(rc); - tmp_uid = PerlProc_getuid(); tmp_euid = PerlProc_geteuid(); } + /* XXX $> et al currently silently ignore failures */ if (PL_delaymagic & DM_GID) { #ifdef HAS_SETRESGID - rc = setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, - (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1, - (Gid_t)-1); + PERL_UNUSED_RESULT( + setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, + (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1, + (Gid_t)-1)); #else # ifdef HAS_SETREGID - rc = setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, - (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1); + PERL_UNUSED_RESULT( + setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, + (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1)); # else # ifdef HAS_SETRGID if ((PL_delaymagic & DM_GID) == DM_RGID) { - rc = setrgid(PL_delaymagic_gid); + PERL_UNUSED_RESULT(setrgid(PL_delaymagic_gid)); PL_delaymagic &= ~DM_RGID; } # endif /* HAS_SETRGID */ # ifdef HAS_SETEGID if ((PL_delaymagic & DM_GID) == DM_EGID) { - rc = setegid(PL_delaymagic_egid); + PERL_UNUSED_RESULT(setegid(PL_delaymagic_egid)); PL_delaymagic &= ~DM_EGID; } # endif /* HAS_SETEGID */ if (PL_delaymagic & DM_GID) { if (PL_delaymagic_gid != PL_delaymagic_egid) DIE(aTHX_ "No setregid available"); - rc = PerlProc_setgid(PL_delaymagic_gid); + PERL_UNUSED_RESULT(PerlProc_setgid(PL_delaymagic_gid)); } # endif /* HAS_SETREGID */ #endif /* HAS_SETRESGID */ - /* XXX $> et al currently silently ignore failures */ - PERL_UNUSED_VAR(rc); - tmp_gid = PerlProc_getgid(); tmp_egid = PerlProc_getegid(); } @@ -1291,7 +1285,7 @@ PP(pp_aassign) PP(pp_qr) { - dVAR; dSP; + dSP; PMOP * const pm = cPMOP; REGEXP * rx = PM_GETRE(pm); SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL; @@ -1310,7 +1304,7 @@ PP(pp_qr) SvROK_on(rv); cvp = &( ReANY((REGEXP *)SvRV(rv))->qr_anoncv); - if ((cv = *cvp) && CvCLONE(*cvp)) { + if (UNLIKELY((cv = *cvp) && CvCLONE(*cvp))) { *cvp = cv_clone(cv); SvREFCNT_dec_NN(cv); } @@ -1321,7 +1315,7 @@ PP(pp_qr) (void)sv_bless(rv, stash); } - if (RX_ISTAINTED(rx)) { + if (UNLIKELY(RX_ISTAINTED(rx))) { SvTAINTED_on(rv); SvTAINTED_on(SvRV(rv)); } @@ -1331,7 +1325,7 @@ PP(pp_qr) PP(pp_match) { - dVAR; dSP; dTARG; + dSP; dTARG; PMOP *pm = cPMOP; PMOP *dynpm = pm; const char *s; @@ -1483,11 +1477,13 @@ PP(pp_match) EXTEND_MORTAL(nparens + i); for (i = !i; i <= nparens; i++) { PUSHs(sv_newmortal()); - if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) { + if (LIKELY((RX_OFFS(rx)[i].start != -1) + && RX_OFFS(rx)[i].end != -1 )) + { const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start; const char * const s = RX_OFFS(rx)[i].start + truebase; - if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 || - len < 0 || len > strend - s) + 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, (long) i, (long) RX_OFFS(rx)[i].start, @@ -1525,7 +1521,7 @@ nope: OP * Perl_do_readline(pTHX) { - dVAR; dSP; dTARGETSTACKED; + dSP; dTARGETSTACKED; SV *sv; STRLEN tmplen = 0; STRLEN offset; @@ -1555,7 +1551,7 @@ Perl_do_readline(pTHX) IoLINES(io) = 0; if (av_tindex(GvAVn(PL_last_in_gv)) < 0) { IoFLAGS(io) &= ~IOf_START; - do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL); + do_open6(PL_last_in_gv, "-", 1, NULL, NULL, 0); SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */ sv_setpvs(GvSVn(PL_last_in_gv), "-"); SvSETMAGIC(GvSV(PL_last_in_gv)); @@ -1691,7 +1687,11 @@ Perl_do_readline(pTHX) } } for (t1 = SvPVX_const(sv); *t1; t1++) +#ifdef __VMS + if (strchr("*%?", *t1)) +#else if (strchr("$&*(){}[]'\";\\|?<>~`", *t1)) +#endif break; if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) { (void)POPs; /* Unmatched wildcard? Chuck it... */ @@ -1729,7 +1729,7 @@ Perl_do_readline(pTHX) PP(pp_helem) { - dVAR; dSP; + dSP; HE* he; SV **svp; SV * const keysv = POPs; @@ -1809,7 +1809,7 @@ PP(pp_helem) PP(pp_iter) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; SV *oldsv; SV **itersvp; @@ -1828,11 +1828,11 @@ 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 (SvNIOK(cur) || SvCUR(cur) > maxlen) + if (UNLIKELY(SvNIOK(cur) || SvCUR(cur) > maxlen)) RETPUSHNO; oldsv = *itersvp; - if (SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv)) { + if (LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) { /* safe to reuse old SV */ sv_setsv(oldsv, cur); } @@ -1854,12 +1854,12 @@ PP(pp_iter) case CXt_LOOP_LAZYIV: /* integer increment */ { IV cur = cx->blk_loop.state_u.lazyiv.cur; - if (cur > cx->blk_loop.state_u.lazyiv.end) + if (UNLIKELY(cur > cx->blk_loop.state_u.lazyiv.end)) RETPUSHNO; oldsv = *itersvp; /* don't risk potential race */ - if (SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv)) { + if (LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) { /* safe to reuse old SV */ sv_setiv(oldsv, cur); } @@ -1872,7 +1872,7 @@ PP(pp_iter) SvREFCNT_dec_NN(oldsv); } - if (cur == IV_MAX) { + if (UNLIKELY(cur == IV_MAX)) { /* Handle end of range at IV_MAX */ cx->blk_loop.state_u.lazyiv.end = IV_MIN; } else @@ -1894,16 +1894,16 @@ PP(pp_iter) } if (PL_op->op_private & OPpITER_REVERSED) { ix = --cx->blk_loop.state_u.ary.ix; - if (ix <= (av_is_stack ? cx->blk_loop.resetsp : -1)) + if (UNLIKELY(ix <= (av_is_stack ? cx->blk_loop.resetsp : -1))) RETPUSHNO; } else { ix = ++cx->blk_loop.state_u.ary.ix; - if (ix > (av_is_stack ? cx->blk_oldsp : AvFILL(av))) + if (UNLIKELY(ix > (av_is_stack ? cx->blk_oldsp : AvFILL(av)))) RETPUSHNO; } - if (SvMAGICAL(av) || AvREIFY(av)) { + if (UNLIKELY(SvMAGICAL(av) || AvREIFY(av))) { SV * const * const svp = av_fetch(av, ix, FALSE); sv = svp ? *svp : NULL; } @@ -1911,8 +1911,8 @@ PP(pp_iter) sv = AvARRAY(av)[ix]; } - if (sv) { - if (SvIS_FREED(sv)) { + if (LIKELY(sv)) { + if (UNLIKELY(SvIS_FREED(sv))) { *itersvp = NULL; Perl_croak(aTHX_ "Use of freed value in iteration"); } @@ -1953,8 +1953,8 @@ While the pattern is being assembled/concatenated and then compiled, PL_tainted will get set (via TAINT_set) if any component of the pattern is tainted, e.g. /.*$tainted/. At the end of pattern compilation, the RXf_TAINTED flag is set on the pattern if PL_tainted is set (via -TAINT_get). Also, if any component of the pattern matches based on -locale-dependent behavior, the RXf_TAINTED_SEEN flag is set. +TAINT_get). It will also be set if any component of the pattern matches +based on locale-dependent behavior. When the pattern is copied, e.g. $r = qr/..../, the SV holding the ref to the pattern is marked as tainted. This means that subsequent usage, such @@ -2013,7 +2013,7 @@ pp_match is just a simpler version of the above. PP(pp_subst) { - dVAR; dSP; dTARG; + dSP; dTARG; PMOP *pm = cPMOP; PMOP *rpm = pm; char *s; @@ -2220,9 +2220,9 @@ PP(pp_subst) d = s = RX_OFFS(rx)[0].start + orig; do { I32 i; - if (iters++ > maxiters) + if (UNLIKELY(iters++ > maxiters)) DIE(aTHX_ "Substitution loop"); - if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ + if (UNLIKELY(RX_MATCH_TAINTED(rx))) /* run time pattern taint, eg locale */ rxtainted |= SUBST_TAINT_PAT; m = RX_OFFS(rx)[0].start + orig; if ((i = m - s)) { @@ -2290,9 +2290,9 @@ PP(pp_subst) } first = TRUE; do { - if (iters++ > maxiters) + if (UNLIKELY(iters++ > maxiters)) DIE(aTHX_ "Substitution loop"); - if (RX_MATCH_TAINTED(rx)) + if (UNLIKELY(RX_MATCH_TAINTED(rx))) rxtainted |= SUBST_TAINT_PAT; if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { char *old_s = s; @@ -2320,7 +2320,7 @@ PP(pp_subst) sv_catsv(dstr, nsv); } else sv_catsv(dstr, repl); - if (SvTAINTED(repl)) + if (UNLIKELY(SvTAINTED(repl))) rxtainted |= SUBST_TAINT_REPL; } if (once) @@ -2394,7 +2394,7 @@ PP(pp_subst) PP(pp_grepwhile) { - dVAR; dSP; + dSP; if (SvTRUEx(POPs)) PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr]; @@ -2403,7 +2403,7 @@ PP(pp_grepwhile) LEAVE_with_name("grep_item"); /* exit inner scope */ /* All done yet? */ - if (PL_stack_base + *PL_markstack_ptr > SP) { + if (UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) { I32 items; const I32 gimme = GIMME_V; @@ -2451,7 +2451,7 @@ PP(pp_grepwhile) PP(pp_leavesub) { - dVAR; dSP; + dSP; SV **mark; SV **newsp; PMOP *newpm; @@ -2468,7 +2468,7 @@ PP(pp_leavesub) TAINT_NOT; if (gimme == G_SCALAR) { MARK = newsp + 1; - if (MARK <= SP) { + if (LIKELY(MARK <= SP)) { if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1 && !SvMAGICAL(TOPs)) { @@ -2518,7 +2518,7 @@ PP(pp_leavesub) PP(pp_entersub) { - dVAR; dSP; dPOPss; + dSP; dPOPss; GV *gv; CV *cv; PERL_CONTEXT *cx; @@ -2544,7 +2544,7 @@ PP(pp_entersub) break; case SVt_PVLV: if(isGV_with_GP(sv)) goto we_have_a_glob; - /*FALLTHROUGH*/ + /* FALLTHROUGH */ default: if (sv == &PL_sv_yes) { /* unfound import, ignore */ if (hasargs) @@ -2574,7 +2574,7 @@ PP(pp_entersub) cv = MUTABLE_CV(SvRV(sv)); if (SvTYPE(cv) == SVt_PVCV) break; - /* FALL THROUGH */ + /* FALLTHROUGH */ case SVt_PVHV: case SVt_PVAV: DIE(aTHX_ "Not a CODE reference"); @@ -2820,7 +2820,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) PP(pp_aelem) { - dVAR; dSP; + dSP; SV** svp; SV* const elemsv = POPs; IV elem = SvIV(elemsv); @@ -2831,14 +2831,14 @@ PP(pp_aelem) bool preeminent = TRUE; SV *sv; - if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) + if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", SVfARG(elemsv)); - if (SvTYPE(av) != SVt_PVAV) + if (UNLIKELY(SvTYPE(av) != SVt_PVAV)) RETPUSHUNDEF; - if (localizing) { + if (UNLIKELY(localizing)) { MAGIC *mg; HV *stash; @@ -2878,7 +2878,7 @@ PP(pp_aelem) 1)); RETURN; } - if (localizing) { + if (UNLIKELY(localizing)) { if (preeminent) save_aelem(av, elem, svp); else @@ -2933,7 +2933,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) PP(pp_method) { - dVAR; dSP; + dSP; SV* const sv = TOPs; if (SvROK(sv)) { @@ -2950,7 +2950,7 @@ PP(pp_method) PP(pp_method_named) { - dVAR; dSP; + dSP; SV* const sv = cSVOP_sv; U32 hash = SvSHARED_HASH(sv); @@ -2961,7 +2961,6 @@ PP(pp_method_named) STATIC SV * S_method_common(pTHX_ SV* meth, U32* hashp) { - dVAR; SV* ob; GV* gv; HV* stash; @@ -2974,7 +2973,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) PERL_ARGS_ASSERT_METHOD_COMMON; - if (!sv) + if (UNLIKELY(!sv)) undefined: Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value", SVfARG(meth)); @@ -3001,22 +3000,12 @@ S_method_common(pTHX_ SV* meth, U32* hashp) GV* iogv; STRLEN packlen; const char * const packname = SvPV_nomg_const(sv, packlen); - const bool packname_is_utf8 = !!SvUTF8(sv); - const HE* const he = - (const HE *)hv_common( - PL_stashcache, NULL, packname, packlen, - packname_is_utf8 ? HVhek_UTF8 : 0, 0, NULL, 0 - ); - - if (he) { - stash = INT2PTR(HV*,SvIV(HeVAL(he))); - DEBUG_o(Perl_deb(aTHX_ "PL_stashcache hit %p for '%"SVf"'\n", - stash, sv)); - goto fetch; - } + const U32 packname_utf8 = SvUTF8(sv); + stash = gv_stashpvn(packname, packlen, packname_utf8 | GV_CACHE_ONLY); + if (stash) goto fetch; if (!(iogv = gv_fetchpvn_flags( - packname, packlen, SVf_UTF8 * packname_is_utf8, SVt_PVIO + packname, packlen, packname_utf8, SVt_PVIO )) || !(ob=MUTABLE_SV(GvIO(iogv)))) { @@ -3028,16 +3017,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) SVfARG(meth)); } /* assume it's a package name */ - stash = gv_stashpvn(packname, packlen, packname_is_utf8 ? SVf_UTF8 : 0); - if (!stash) - packsv = sv; - else { - SV* const ref = newSViv(PTR2IV(stash)); - (void)hv_store(PL_stashcache, packname, - packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0); - DEBUG_o(Perl_deb(aTHX_ "PL_stashcache caching %p for '%"SVf"'\n", - stash, sv)); - } + stash = gv_stashpvn(packname, packlen, packname_utf8); + if (!stash) packsv = sv; goto fetch; } /* it _is_ a filehandle name -- replace with a reference */ @@ -3067,6 +3048,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) const HE* const he = hv_fetch_ent(stash, meth, 0, *hashp); if (he) { gv = MUTABLE_GV(HeVAL(he)); + assert(stash); if (isGV(gv) && GvCV(gv) && (!GvCVGEN(gv) || GvCVGEN(gv) == (PL_sub_generation + HvMROMETA(stash)->cache_gen))) @@ -3074,9 +3056,9 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } } + assert(stash || packsv); gv = gv_fetchmethod_sv_flags(stash ? stash : MUTABLE_HV(packsv), - meth, GV_AUTOLOAD | GV_CROAK); - + meth, GV_AUTOLOAD | GV_CROAK); assert(gv); return isGV(gv) ? MUTABLE_SV(GvCV(gv)) : MUTABLE_SV(gv);