This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_subst: move a bock of code to to decrease gotos
[perl5.git] / pp_hot.c
index ce465e7..494c50f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -324,7 +324,7 @@ PP(pp_readline)
            dSP;
            XPUSHs(MUTABLE_SV(PL_last_in_gv));
            PUTBACK;
-           pp_rv2gv();
+           Perl_pp_rv2gv(aTHX);
            PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
        }
     }
@@ -729,22 +729,11 @@ PP(pp_print)
            Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
            ++SP;
        }
-       PUSHMARK(MARK - 1);
-       *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
-       PUTBACK;
-       ENTER_with_name("call_PRINT");
-       if( PL_op->op_type == OP_SAY ) {
-               /* local $\ = "\n" */
-               SAVEGENERICSV(PL_ors_sv);
-               PL_ors_sv = newSVpvs("\n");
-       }
-       call_method("PRINT", G_SCALAR);
-       LEAVE_with_name("call_PRINT");
-       SPAGAIN;
-       MARK = ORIGMARK + 1;
-       *MARK = *SP;
-       SP = MARK;
-       RETURN;
+       return Perl_tied_method(aTHX_ "PRINT", mark - 1, MUTABLE_SV(io),
+                               mg,
+                               (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK
+                                | (PL_op->op_type == OP_SAY
+                                   ? TIED_METHOD_SAY : 0)), sp - mark);
     }
     if (!io) {
         if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))
@@ -888,7 +877,7 @@ PP(pp_rv2av)
 
     if (is_pp_rv2av) {
        AV *const av = MUTABLE_AV(sv);
-       /* The guts of pp_rv2av, with no intenting change to preserve history
+       /* The guts of pp_rv2av, with no intending change to preserve history
           (until such time as we get tools that can do blame annotation across
           whitespace changes.  */
        if (gimme == G_ARRAY) {
@@ -919,7 +908,7 @@ PP(pp_rv2av)
        /* The guts of pp_rv2hv  */
        if (gimme == G_ARRAY) { /* array wanted */
            *PL_stack_sp = sv;
-           return do_kv();
+           return Perl_do_kv(aTHX);
        }
        else if (gimme == G_SCALAR) {
            dTARGET;
@@ -1578,21 +1567,15 @@ Perl_do_readline(pTHX)
     const I32 gimme = GIMME_V;
 
     if (io) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+       const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER_with_name("call_READLINE");
-           call_method("READLINE", gimme);
-           LEAVE_with_name("call_READLINE");
-           SPAGAIN;
+           Perl_tied_method(aTHX_ "READLINE", SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
-               SV* const result = POPs;
-               SvSetSV_nosteal(TARG, result);
-               PUSHTARG;
+               SPAGAIN;
+               SvSetSV_nosteal(TARG, TOPs);
+               SETTARG;
            }
-           RETURN;
+           return NORMAL;
        }
     }
     fp = NULL;
@@ -2178,7 +2161,7 @@ PP(pp_subst)
        s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
 
        if (!s)
-           goto nope;
+           goto ret_no;
        /* How to do it in subst? */
 /*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
@@ -2233,6 +2216,14 @@ PP(pp_subst)
        doutf8 = FALSE;
     }
     
+    if (!matched) {
+      ret_no:
+       SPAGAIN;
+       PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
+       LEAVE_SCOPE(oldsave);
+       RETURN;
+    }
+
     /* can do inplace substitution? */
     if (c
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -2240,17 +2231,9 @@ PP(pp_subst)
 #endif
        && (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR))
        && !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN)
-       && (!doutf8 || SvUTF8(TARG))) {
-       if (!matched)
-       {
-           SPAGAIN;
-           if (rpm->op_pmflags & PMf_NONDESTRUCT)
-               PUSHs(TARG);
-           else
-               PUSHs(&PL_sv_no);
-           LEAVE_SCOPE(oldsave);
-           RETURN;
-       }
+       && (!doutf8 || SvUTF8(TARG)))
+    {
+
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW(TARG)) {
            assert (!force_on_match);
@@ -2301,10 +2284,7 @@ PP(pp_subst)
            }
            TAINT_IF(rxtainted & 1);
            SPAGAIN;
-           if (rpm->op_pmflags & PMf_NONDESTRUCT)
-               PUSHs(TARG);
-           else
-               PUSHs(&PL_sv_yes);
+           PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_yes);
        }
        else {
            do {
@@ -2351,9 +2331,7 @@ PP(pp_subst)
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
-
-    if (matched)
-    {
+    else {
        if (force_on_match) {
            force_on_match = 0;
            s = SvPV_force(TARG, len);
@@ -2436,17 +2414,7 @@ PP(pp_subst)
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
-    goto ret_no;
-
-nope:
-ret_no:
-    SPAGAIN;
-    if (rpm->op_pmflags & PMf_NONDESTRUCT)
-       PUSHs(TARG);
-    else
-       PUSHs(&PL_sv_no);
-    LEAVE_SCOPE(oldsave);
-    RETURN;
+    /* NOTREACHED */
 }
 
 PP(pp_grepwhile)