X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/924ba0765e4151c6d9a29ad6b3c3f97c24673477..f702f024a09f5c3dad77e5c753e7e27e5102d847:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index e705230..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,7 +56,6 @@ PP(pp_nextstate) PP(pp_gvsv) { - dVAR; dSP; EXTEND(SP,1); if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) @@ -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. */ @@ -228,7 +222,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - dVAR; dSP; + dSP; PERL_ASYNC_CHECK(); if (SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other); @@ -238,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; @@ -252,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; @@ -357,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; @@ -398,7 +391,7 @@ PP(pp_padrange) PP(pp_padsv) { - dVAR; dSP; + dSP; EXTEND(SP, 1); { OP * const op = PL_op; @@ -428,7 +421,6 @@ PP(pp_padsv) PP(pp_readline) { - dVAR; dSP; if (TOPs) { SvGETMAGIC(TOPs); @@ -452,7 +444,7 @@ PP(pp_readline) PP(pp_eq) { - dVAR; dSP; + dSP; SV *left, *right; tryAMAGICbin_MG(eq_amg, AMGf_set|AMGf_numeric); @@ -468,7 +460,7 @@ 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 (UNLIKELY(SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))) @@ -488,7 +480,7 @@ PP(pp_preinc) PP(pp_or) { - dVAR; dSP; + dSP; PERL_ASYNC_CHECK(); if (SvTRUE(TOPs)) RETURN; @@ -501,7 +493,7 @@ PP(pp_or) PP(pp_defined) { - dVAR; dSP; + dSP; SV* sv; bool defined; const int op_type = PL_op->op_type; @@ -559,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; @@ -724,7 +716,7 @@ 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; @@ -743,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; @@ -753,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 @@ -774,7 +766,7 @@ PP(pp_pushre) PP(pp_print) { - dVAR; dSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; PerlIO *fp; MAGIC *mg; GV * const gv @@ -868,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"; @@ -962,8 +954,6 @@ PP(pp_rv2av) STATIC void S_do_oddball(pTHX_ SV **oddkey, SV **firstkey) { - dVAR; - PERL_ARGS_ASSERT_DO_ODDBALL; if (*oddkey) { @@ -1182,82 +1172,81 @@ PP(pp_aassign) } } if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) { - int rc = 0; /* 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(); } @@ -1296,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; @@ -1336,7 +1325,7 @@ PP(pp_qr) PP(pp_match) { - dVAR; dSP; dTARG; + dSP; dTARG; PMOP *pm = cPMOP; PMOP *dynpm = pm; const char *s; @@ -1532,7 +1521,7 @@ nope: OP * Perl_do_readline(pTHX) { - dVAR; dSP; dTARGETSTACKED; + dSP; dTARGETSTACKED; SV *sv; STRLEN tmplen = 0; STRLEN offset; @@ -1740,7 +1729,7 @@ Perl_do_readline(pTHX) PP(pp_helem) { - dVAR; dSP; + dSP; HE* he; SV **svp; SV * const keysv = POPs; @@ -1820,7 +1809,7 @@ PP(pp_helem) PP(pp_iter) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; SV *oldsv; SV **itersvp; @@ -2024,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; @@ -2405,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]; @@ -2462,7 +2451,7 @@ PP(pp_grepwhile) PP(pp_leavesub) { - dVAR; dSP; + dSP; SV **mark; SV **newsp; PMOP *newpm; @@ -2529,7 +2518,7 @@ PP(pp_leavesub) PP(pp_entersub) { - dVAR; dSP; dPOPss; + dSP; dPOPss; GV *gv; CV *cv; PERL_CONTEXT *cx; @@ -2831,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); @@ -2944,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)) { @@ -2961,7 +2950,7 @@ PP(pp_method) PP(pp_method_named) { - dVAR; dSP; + dSP; SV* const sv = cSVOP_sv; U32 hash = SvSHARED_HASH(sv); @@ -2972,7 +2961,6 @@ PP(pp_method_named) STATIC SV * S_method_common(pTHX_ SV* meth, U32* hashp) { - dVAR; SV* ob; GV* gv; HV* stash; @@ -3012,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)))) { @@ -3039,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 */