This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c, regexec.c: Move common code to a function
[perl5.git] / pp_hot.c
index ae88d83..e705230 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -61,7 +61,7 @@ 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));
@@ -133,9 +133,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 +215,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_
@@ -330,7 +331,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 +345,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;
@@ -470,9 +471,9 @@ PP(pp_preinc)
     dVAR; 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));
@@ -509,7 +510,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 +519,7 @@ PP(pp_defined)
     else {
        /* OP_DEFINED */
         sv = POPs;
-        if (!sv || !SvANY(sv))
+        if (UNLIKELY(!sv || !SvANY(sv)))
             RETPUSHNO;
     }
 
@@ -727,8 +728,12 @@ PP(pp_aelemfast)
     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);
@@ -872,18 +877,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 +908,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)
@@ -1022,13 +1027,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 +1051,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 +1065,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 +1079,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 +1094,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 +1104,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 +1164,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,7 +1181,7 @@ PP(pp_aassign)
            break;
        }
     }
-    if (PL_delaymagic & ~DM_DELAY) {
+    if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) {
         int rc = 0;
        /* Will be used to set PL_tainting below */
        Uid_t tmp_uid  = PerlProc_getuid();
@@ -1310,7 +1315,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 +1326,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));
     }
@@ -1483,11 +1488,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,
@@ -1555,7 +1562,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 +1698,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... */
@@ -1828,11 +1839,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 +1865,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 +1883,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 +1905,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 +1922,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 +1964,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
@@ -2220,9 +2231,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 +2301,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 +2331,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)
@@ -2403,7 +2414,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;
 
@@ -2468,7 +2479,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)) {
@@ -2544,7 +2555,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 +2585,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");
@@ -2831,14 +2842,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 +2889,7 @@ PP(pp_aelem)
                1));
            RETURN;
        }
-       if (localizing) {
+       if (UNLIKELY(localizing)) {
            if (preeminent)
                save_aelem(av, elem, svp);
            else
@@ -2974,7 +2985,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));
@@ -3067,6 +3078,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 +3086,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);