This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta for 3480fbaaaea8
[perl5.git] / pp_hot.c
index 8ab26f9..1094510 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -76,7 +76,8 @@ PP(pp_null)
     return NORMAL;
 }
 
-/* This is sometimes called directly by pp_coreargs and pp_grepstart. */
+/* This is sometimes called directly by pp_coreargs, pp_grepstart and
+   amagic_call. */
 PP(pp_pushmark)
 {
     PUSHMARK(PL_stack_sp);
@@ -299,15 +300,10 @@ PP(pp_concat)
     }
 
     if (!rcopied) {
-       if (left == right)
-           /* $r.$r: do magic twice: tied might return different 2nd time */
-           SvGETMAGIC(right);
        rpv = SvPV_nomg_const(right, rlen);
        rbyte = !DO_UTF8(right);
     }
     if (lbyte != rbyte) {
-       /* sv_utf8_upgrade_nomg() may reallocate the stack */
-       PUTBACK;
        if (lbyte)
            sv_utf8_upgrade_nomg(TARG);
        else {
@@ -316,7 +312,6 @@ PP(pp_concat)
            sv_utf8_upgrade_nomg(right);
            rpv = SvPV_nomg_const(right, rlen);
        }
-       SPAGAIN;
     }
     sv_catpvn_nomg(TARG, rpv, rlen);
 
@@ -653,8 +648,8 @@ PP(pp_add)
                    if (aiv >= 0) {
                        auv = aiv;
                        auvok = 1;      /* Now acting as a sign flag.  */
-                   } else { /* 2s complement assumption for IV_MIN */
-                       auv = (UV)-aiv;
+                   } else {
+                       auv = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
                    }
                }
                a_valid = 1;
@@ -674,7 +669,7 @@ PP(pp_add)
                    buv = biv;
                    buvok = 1;
                } else
-                   buv = (UV)-biv;
+                    buv = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
            }
            /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
               else "IV" now, independent of how it came in.
@@ -715,7 +710,8 @@ PP(pp_add)
                else {
                    /* Negate result */
                    if (result <= (UV)IV_MIN)
-                       SETi( -(IV)result );
+                        SETi(result == (UV)IV_MIN
+                                ? IV_MIN : -(IV)result);
                    else {
                        /* result valid, but out of range for IV.  */
                        SETn( -(NV)result );
@@ -1390,7 +1386,7 @@ PP(pp_match)
     const char *truebase;                      /* Start of string  */
     REGEXP *rx = PM_GETRE(pm);
     bool rxtainted;
-    const I32 gimme = GIMME;
+    const I32 gimme = GIMME_V;
     STRLEN len;
     const I32 oldsave = PL_savestack_ix;
     I32 had_zerolen = 0;
@@ -1559,7 +1555,7 @@ PP(pp_match)
     }
     NOT_REACHED; /* NOTREACHED */
 
-nope:
+  nope:
     if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
         if (!mg)
             mg = mg_find_mglob(TARG);
@@ -1637,8 +1633,7 @@ Perl_do_readline(pTHX)
        if (gimme == G_SCALAR) {
            /* undef TARG, and push that undefined value */
            if (type != OP_RCATLINE) {
-               SV_CHECK_THINKFIRST_COW_DROP(TARG);
-               SvOK_off(TARG);
+               sv_setsv(TARG,NULL);
            }
            PUSHTARG;
        }
@@ -1882,14 +1877,14 @@ S_softref2xv_lite(pTHX_ SV *const sv, const char *const what,
 }
 
 
-/* handle one or more derefs and array/hash indexings, e.g.
- * $h->{foo} or $a[0]{$key}[$i] or f()->[1]
+/* Handle one or more aggregate derefs and array/hash indexings, e.g.
+ * $h->{foo}  or  $a[0]{$key}[$i]  or  f()->[1]
  *
  * op_aux points to an array of unions of UV / IV / SV* / PADOFFSET.
- * Each of these either contains an action, or an argument, such as
- * a UV to use as an array index, or a lexical var to retrieve.
- * In fact, several actions re stored per UV; we keep shifting new actions
- * of the one UV, and only reload when it becomes zero.
+ * Each of these either contains a set of actions, or an argument, such as
+ * an IV to use as an array index, or a lexical var to retrieve.
+ * Several actions re stored per UV; we keep shifting new actions off the
+ * one UV, and only reload when it becomes zero.
  */
 
 PP(pp_multideref)
@@ -2514,8 +2509,8 @@ PP(pp_subst)
     char *strend;
     const char *c;
     STRLEN clen;
-    I32 iters = 0;
-    I32 maxiters;
+    SSize_t iters = 0;
+    SSize_t maxiters;
     bool once;
     U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits.
                        See "how taint works" above */
@@ -2739,7 +2734,7 @@ PP(pp_subst)
                Move(s, d, i+1, char);          /* include the NUL */
            }
            SPAGAIN;
-           mPUSHi((I32)iters);
+           mPUSHi(iters);
        }
     }
     else {
@@ -2851,7 +2846,7 @@ PP(pp_subst)
            SvPV_set(dstr, NULL);
 
            SPAGAIN;
-           mPUSHi((I32)iters);
+           mPUSHi(iters);
        }
     }
 
@@ -2952,8 +2947,12 @@ PP(pp_leavesub)
     PERL_CONTEXT *cx;
     SV *sv;
 
-    if (CxMULTICALL(&cxstack[cxstack_ix]))
+    if (CxMULTICALL(&cxstack[cxstack_ix])) {
+        /* entry zero of a stack is always PL_sv_undef, which
+         * simplifies converting a '()' return into undef in scalar context */
+        assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
        return 0;
+    }
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
@@ -3101,7 +3100,7 @@ PP(pp_entersub)
        }
        /* should call AUTOLOAD now? */
        else {
-try_autoload:
+          try_autoload:
            if ((autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
                                   GvNAMEUTF8(gv) ? SVf_UTF8 : 0)))
            {
@@ -3616,11 +3615,5 @@ PP(pp_method_redir_super)
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */