X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d263c0173f6ababa6791fd24914c3a92725ce5f0..b823713ce3ee6bfd4d009e6307703c7d2e63b7c8:/scope.c diff --git a/scope.c b/scope.c index 23ade78..07f24b7 100644 --- a/scope.c +++ b/scope.c @@ -88,7 +88,7 @@ void Perl_push_scope(pTHX) { dVAR; - if (PL_scopestack_ix == PL_scopestack_max) { + if (UNLIKELY(PL_scopestack_ix == PL_scopestack_max)) { PL_scopestack_max = GROW(PL_scopestack_max); Renew(PL_scopestack, PL_scopestack_max, I32); #ifdef DEBUGGING @@ -164,7 +164,7 @@ Perl_free_tmps(pTHX) #ifdef PERL_POISON PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB); #endif - if (sv && sv != &PL_sv_undef) { + if (LIKELY(sv && sv != &PL_sv_undef)) { SvTEMP_off(sv); SvREFCNT_dec_NN(sv); /* note, can modify tmps_ix!!! */ } @@ -214,7 +214,7 @@ Perl_save_scalar(pTHX_ GV *gv) PERL_ARGS_ASSERT_SAVE_SCALAR; - if (SvGMAGICAL(*sptr)) { + if (UNLIKELY(SvGMAGICAL(*sptr))) { PL_localizing = 1; (void)mg_get(*sptr); PL_localizing = 0; @@ -321,13 +321,13 @@ Perl_save_ary(pTHX_ GV *gv) PERL_ARGS_ASSERT_SAVE_ARY; - if (!AvREAL(oav) && AvREIFY(oav)) + if (UNLIKELY(!AvREAL(oav) && AvREIFY(oav))) av_reify(oav); save_pushptrptr(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV); GvAV(gv) = NULL; av = GvAVn(gv); - if (SvMAGIC(oav)) + if (UNLIKELY(SvMAGIC(oav))) mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE); return av; } @@ -346,7 +346,7 @@ Perl_save_hash(pTHX_ GV *gv) GvHV(gv) = NULL; hv = GvHVn(gv); - if (SvMAGIC(ohv)) + if (UNLIKELY(SvMAGIC(ohv))) mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE); return hv; } @@ -400,7 +400,7 @@ Perl_save_int(pTHX_ int *intp) PERL_ARGS_ASSERT_SAVE_INT; - if ((int)(type >> SAVE_TIGHT_SHIFT) != i) { + if (UNLIKELY((int)(type >> SAVE_TIGHT_SHIFT) != i)) { SS_ADD_INT(i); type = SAVEt_INT; size++; @@ -447,7 +447,7 @@ Perl_save_I32(pTHX_ I32 *intp) PERL_ARGS_ASSERT_SAVE_I32; - if ((I32)(type >> SAVE_TIGHT_SHIFT) != i) { + if (UNLIKELY((I32)(type >> SAVE_TIGHT_SHIFT) != i)) { SS_ADD_INT(i); type = SAVEt_I32; size++; @@ -559,7 +559,7 @@ Perl_save_clearsv(pTHX_ SV **svp) ASSERT_CURPAD_ACTIVE("save_clearsv"); SvPADSTALE_off(*svp); /* mark lexical as active */ - if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset) { + if (UNLIKELY((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)) { Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)", offset, svp, PL_curpad); } @@ -681,7 +681,7 @@ Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr, SS_ADD_END(4); /* The array needs to hold a reference count on its new element, so it must be AvREAL. */ - if (!AvREAL(av) && AvREIFY(av)) + if (UNLIKELY(!AvREAL(av) && AvREIFY(av))) av_reify(av); save_scalar_at(sptr, flags); /* XXX - FIXME - see #60360 */ if (flags & SAVEf_KEEPOLDELEM) @@ -691,7 +691,7 @@ Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr, * won't actually be stored in the array - so it won't get * reaped when the localize ends. Ensure it gets reaped by * mortifying it instead. DAPM */ - if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) + if (UNLIKELY(SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) sv_2mortal(sv); } @@ -720,7 +720,7 @@ Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags) * won't actually be stored in the hash - so it won't get * reaped when the localize ends. Ensure it gets reaped by * mortifying it instead. DAPM */ - if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) + if (UNLIKELY(SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))) sv_2mortal(sv); } @@ -745,7 +745,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); const UV elems_shifted = elems << SAVE_TIGHT_SHIFT; - if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems) + if (UNLIKELY((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)) Perl_croak(aTHX_ "panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")", elems, (IV)size, (IV)pad); @@ -798,7 +798,7 @@ Perl_leave_scope(pTHX_ I32 base) arg1.any_ptr = NULL; arg2.any_ptr = NULL; - if (base < -1) + if (UNLIKELY(base < -1)) Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base); DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n", (long)PL_savestack_ix, (long)base)); @@ -833,7 +833,7 @@ Perl_leave_scope(pTHX_ I32 base) switch (type) { case SAVEt_ITEM: /* normal string */ sv_replace(ARG1_SV, ARG0_SV); - if (SvSMAGICAL(ARG1_SV)) { + if (UNLIKELY(SvSMAGICAL(ARG1_SV))) { PL_localizing = 2; mg_set(ARG1_SV); PL_localizing = 0; @@ -855,7 +855,7 @@ Perl_leave_scope(pTHX_ I32 base) SV * const sv = *svp; *svp = ARG0_SV; SvREFCNT_dec(sv); - if (SvSMAGICAL(ARG0_SV)) { + if (UNLIKELY(SvSMAGICAL(ARG0_SV))) { PL_localizing = 2; mg_set(ARG0_SV); PL_localizing = 0; @@ -913,7 +913,7 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_AV: /* array reference */ SvREFCNT_dec(GvAV(ARG1_GV)); GvAV(ARG1_GV) = ARG0_AV; - if (SvSMAGICAL(ARG0_SV)) { + if (UNLIKELY(SvSMAGICAL(ARG0_SV))) { PL_localizing = 2; mg_set(ARG0_SV); PL_localizing = 0; @@ -923,7 +923,7 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_HV: /* hash reference */ SvREFCNT_dec(GvHV(ARG1_GV)); GvHV(ARG1_GV) = ARG0_HV; - if (SvSMAGICAL(ARG0_SV)) { + if (UNLIKELY(SvSMAGICAL(ARG0_SV))) { PL_localizing = 2; mg_set(ARG0_SV); PL_localizing = 0; @@ -944,7 +944,7 @@ Perl_leave_scope(pTHX_ I32 base) #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was); #else - if (ARG0_PTR == &(TAINT_get)) { + if (UNLIKELY(ARG0_PTR == &(TAINT_get))) { /* If we don't update , to reflect what was saved on the * stack for PL_tainted, then we will overwrite this attempt to * restore it when we exit this routine. Note that this won't @@ -1039,18 +1039,14 @@ Perl_leave_scope(pTHX_ I32 base) assert(SvPADMY(sv)); /* Can clear pad variable in place? */ - if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) { - - /* note that backrefs (either in HvAUX or magic) - * must be removed before other magic */ - if (SvTYPE(sv) == SVt_PVHV) - Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv)); + if (SvREFCNT(sv) == 1 && !SvOBJECT(sv)) { /* these flags are the union of all the relevant flags * in the individual conditions within */ if (UNLIKELY(SvFLAGS(sv) & ( SVf_READONLY /* for SvREADONLY_off() */ | (SVs_GMG|SVs_SMG|SVs_RMG) /* SvMAGICAL() */ + | SVf_OOK | SVf_THINKFIRST))) { /* if a my variable that was made readonly is @@ -1061,7 +1057,16 @@ Perl_leave_scope(pTHX_ I32 base) if (SvREADONLY(sv) && !SvFAKE(sv)) SvREADONLY_off(sv); + if (SvOOK(sv)) { /* OOK or HvAUX */ + if (SvTYPE(sv) == SVt_PVHV) + Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv)); + else + sv_backoff(sv); + } + if (SvMAGICAL(sv)) { + /* note that backrefs (either in HvAUX or magic) + * must be removed before other magic */ sv_unmagic(sv, PERL_MAGIC_backref); if (SvTYPE(sv) != SVt_PVCV) mg_free(sv); @@ -1090,7 +1095,12 @@ Perl_leave_scope(pTHX_ I32 base) break; } default: - SvOK_off(sv); + /* This looks odd, but these two macros are for use in + expressions and finish with a trailing comma, so + adding a ; after them would be wrong. */ + assert_not_ROK(sv) + assert_not_glob(sv) + SvFLAGS(sv) &=~ (SVf_OK|SVf_IVisUV|SVf_UTF8); break; } SvPADSTALE_on(sv); /* mark as no longer live */ @@ -1144,12 +1154,12 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_AELEM: /* array element */ svp = av_fetch(ARG2_AV, arg1.any_iv, 1); - if (!AvREAL(ARG2_AV) && AvREIFY(ARG2_AV)) /* undo reify guard */ + if (UNLIKELY(!AvREAL(ARG2_AV) && AvREIFY(ARG2_AV))) /* undo reify guard */ SvREFCNT_dec(ARG0_SV); - if (svp) { + if (LIKELY(svp)) { SV * const sv = *svp; - if (sv && sv != &PL_sv_undef) { - if (SvTIED_mg((const SV *)ARG2_AV, PERL_MAGIC_tied)) + if (LIKELY(sv && sv != &PL_sv_undef)) { + if (UNLIKELY(SvTIED_mg((const SV *)ARG2_AV, PERL_MAGIC_tied))) SvREFCNT_inc_void_NN(sv); refsv = ARG2_SV; goto restore_sv; @@ -1162,11 +1172,11 @@ Perl_leave_scope(pTHX_ I32 base) { HE * const he = hv_fetch_ent(ARG2_HV, ARG1_SV, 1, 0); SvREFCNT_dec(ARG1_SV); - if (he) { + if (LIKELY(he)) { const SV * const oval = HeVAL(he); - if (oval && oval != &PL_sv_undef) { + if (LIKELY(oval && oval != &PL_sv_undef)) { svp = &HeVAL(he); - if (SvTIED_mg((const SV *)ARG2_HV, PERL_MAGIC_tied)) + if (UNLIKELY(SvTIED_mg((const SV *)ARG2_HV, PERL_MAGIC_tied))) SvREFCNT_inc_void(*svp); refsv = ARG2_SV; /* what to refcnt_dec */ goto restore_sv; @@ -1205,7 +1215,7 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_COMPPAD: PL_comppad = (PAD*)ARG0_PTR; - if (PL_comppad) + if (LIKELY(PL_comppad)) PL_curpad = AvARRAY(PL_comppad); else PL_curpad = NULL;