This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
pp_hot.c: pp_rv2av: Squash repetitive code
[perl5.git] / pp_hot.c
diff --git a/pp_hot.c b/pp_hot.c
index 594d114..6c3f4f6 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -74,7 +74,7 @@ PP(pp_null)
     return NORMAL;
 }
 
     return NORMAL;
 }
 
-/* This is sometimes called directly by pp_coreargs. */
+/* This is sometimes called directly by pp_coreargs and pp_grepstart. */
 PP(pp_pushmark)
 {
     dVAR;
 PP(pp_pushmark)
 {
     dVAR;
@@ -112,30 +112,34 @@ PP(pp_and)
 
 PP(pp_sassign)
 {
 
 PP(pp_sassign)
 {
-    dVAR; dSP; dPOPTOPssrl;
+    dVAR; dSP;
+    /* sassign keeps its args in the optree traditionally backwards.
+       So we pop them differently.
+    */
+    SV *left = POPs; SV *right = TOPs;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
        SV * const temp = left;
        left = right; right = temp;
     }
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
        SV * const temp = left;
        left = right; right = temp;
     }
-    if (PL_tainting && PL_tainted && !SvTAINTED(left))
+    if (PL_tainting && PL_tainted && !SvTAINTED(right))
        TAINT_NOT;
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
        TAINT_NOT;
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
-       SV * const cv = SvRV(left);
+       SV * const cv = SvRV(right);
        const U32 cv_type = SvTYPE(cv);
        const U32 cv_type = SvTYPE(cv);
-       const bool is_gv = isGV_with_GP(right);
+       const bool is_gv = isGV_with_GP(left);
        const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
        if (!got_coderef) {
            assert(SvROK(cv));
        }
 
        const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
        if (!got_coderef) {
            assert(SvROK(cv));
        }
 
-       /* Can do the optimisation if right (LVALUE) is not a typeglob,
-          left (RVALUE) is a reference to something, and we're in void
+       /* Can do the optimisation if left (LVALUE) is not a typeglob,
+          right (RVALUE) is a reference to something, and we're in void
           context. */
        if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
            /* Is the target symbol table currently empty?  */
           context. */
        if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
            /* Is the target symbol table currently empty?  */
-           GV * const gv = gv_fetchsv_nomg(right, GV_NOINIT, SVt_PVGV);
+           GV * const gv = gv_fetchsv_nomg(left, GV_NOINIT, SVt_PVGV);
            if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
                /* Good. Create a new proxy constant subroutine in the target.
                   The gv becomes a(nother) reference to the constant.  */
            if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
                /* Good. Create a new proxy constant subroutine in the target.
                   The gv becomes a(nother) reference to the constant.  */
@@ -145,7 +149,7 @@ PP(pp_sassign)
                SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
                SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
-               SETs(right);
+               SETs(left);
                RETURN;
            }
        }
                RETURN;
            }
        }
@@ -153,7 +157,7 @@ PP(pp_sassign)
        /* Need to fix things up.  */
        if (!is_gv) {
            /* Need to fix GV.  */
        /* Need to fix things up.  */
        if (!is_gv) {
            /* Need to fix GV.  */
-           right = MUTABLE_SV(gv_fetchsv_nomg(right,GV_ADD, SVt_PVGV));
+           left = MUTABLE_SV(gv_fetchsv_nomg(left,GV_ADD, SVt_PVGV));
        }
 
        if (!got_coderef) {
        }
 
        if (!got_coderef) {
@@ -167,7 +171,7 @@ PP(pp_sassign)
                   all sorts of fun as the reference to our new sub is
                   donated to the GV that we're about to assign to.
                */
                   all sorts of fun as the reference to our new sub is
                   donated to the GV that we're about to assign to.
                */
-               SvRV_set(left, MUTABLE_SV(newCONSTSUB(GvSTASH(right), NULL,
+               SvRV_set(right, MUTABLE_SV(newCONSTSUB(GvSTASH(left), NULL,
                                                      SvRV(cv))));
                SvREFCNT_dec(cv);
                LEAVE_with_name("sassign_coderef");
                                                      SvRV(cv))));
                SvREFCNT_dec(cv);
                LEAVE_with_name("sassign_coderef");
@@ -193,20 +197,20 @@ PP(pp_sassign)
 
                SvREFCNT_inc_void(source);
                SvREFCNT_dec(upgraded);
 
                SvREFCNT_inc_void(source);
                SvREFCNT_dec(upgraded);
-               SvRV_set(left, MUTABLE_SV(source));
+               SvRV_set(right, MUTABLE_SV(source));
            }
        }
 
     }
     if (
            }
        }
 
     }
     if (
-      SvTEMP(right) && !SvSMAGICAL(right) && SvREFCNT(right) == 1 &&
-      (!isGV_with_GP(right) || SvFAKE(right)) && ckWARN(WARN_MISC)
+      SvTEMP(left) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 &&
+      (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC)
     )
        Perl_warner(aTHX_
            packWARN(WARN_MISC), "Useless assignment to a temporary"
        );
     )
        Perl_warner(aTHX_
            packWARN(WARN_MISC), "Useless assignment to a temporary"
        );
-    SvSetMagicSV(right, left);
-    SETs(right);
+    SvSetMagicSV(left, right);
+    SETs(left);
     RETURN;
 }
 
     RETURN;
 }
 
@@ -325,7 +329,7 @@ PP(pp_readline)
     dSP;
     if (TOPs) {
        SvGETMAGIC(TOPs);
     dSP;
     if (TOPs) {
        SvGETMAGIC(TOPs);
-       tryAMAGICunTARGET(iter_amg, 0, 0);
+       tryAMAGICunTARGETlist(iter_amg, 0, 0);
        PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
     }
     else PL_last_in_gv = PL_argvgv, PL_stack_sp--;
        PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
     }
     else PL_last_in_gv = PL_argvgv, PL_stack_sp--;
@@ -362,16 +366,19 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dVAR; dSP;
 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)))
        Perl_croak_no_modify(aTHX);
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
        Perl_croak_no_modify(aTHX);
-    if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
-        && SvIVX(TOPs) != IV_MAX)
+    if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+        && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
     {
     {
-       SvIV_set(TOPs, SvIVX(TOPs) + 1);
+       SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
        SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
        SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
-       sv_inc(TOPs);
+       if (inc) sv_inc(TOPs);
+       else sv_dec(TOPs);
     SvSETMAGIC(TOPs);
     return NORMAL;
 }
     SvSETMAGIC(TOPs);
     return NORMAL;
 }
@@ -392,7 +399,7 @@ PP(pp_or)
 PP(pp_defined)
 {
     dVAR; dSP;
 PP(pp_defined)
 {
     dVAR; dSP;
-    register SV* sv;
+    SV* sv;
     bool defined;
     const int op_type = PL_op->op_type;
     const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
     bool defined;
     const int op_type = PL_op->op_type;
     const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
@@ -502,13 +509,11 @@ PP(pp_add)
        unsigned code below is actually shorter than the old code. :-)
     */
 
        unsigned code below is actually shorter than the old code. :-)
     */
 
-    SvIV_please_nomg(svr);
-
-    if (SvIOK(svr)) {
+    if (SvIV_please_nomg(svr)) {
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
-       register UV auv = 0;
+       UV auv = 0;
        bool auvok = FALSE;
        bool a_valid = 0;
 
        bool auvok = FALSE;
        bool a_valid = 0;
 
@@ -520,12 +525,11 @@ PP(pp_add)
               lots of code to speed up what is probably a rarish case.  */
        } else {
            /* Left operand is defined, so is it IV? */
               lots of code to speed up what is probably a rarish case.  */
        } else {
            /* Left operand is defined, so is it IV? */
-           SvIV_please_nomg(svl);
-           if (SvIOK(svl)) {
+           if (SvIV_please_nomg(svl)) {
                if ((auvok = SvUOK(svl)))
                    auv = SvUVX(svl);
                else {
                if ((auvok = SvUOK(svl)))
                    auv = SvUVX(svl);
                else {
-                   register const IV aiv = SvIVX(svl);
+                   const IV aiv = SvIVX(svl);
                    if (aiv >= 0) {
                        auv = aiv;
                        auvok = 1;      /* Now acting as a sign flag.  */
                    if (aiv >= 0) {
                        auv = aiv;
                        auvok = 1;      /* Now acting as a sign flag.  */
@@ -539,13 +543,13 @@ PP(pp_add)
        if (a_valid) {
            bool result_good = 0;
            UV result;
        if (a_valid) {
            bool result_good = 0;
            UV result;
-           register UV buv;
+           UV buv;
            bool buvok = SvUOK(svr);
        
            if (buvok)
                buv = SvUVX(svr);
            else {
            bool buvok = SvUOK(svr);
        
            if (buvok)
                buv = SvUVX(svr);
            else {
-               register const IV biv = SvIVX(svr);
+               const IV biv = SvIVX(svr);
                if (biv >= 0) {
                    buv = biv;
                    buvok = 1;
                if (biv >= 0) {
                    buv = biv;
                    buvok = 1;
@@ -664,7 +668,7 @@ PP(pp_pushre)
 PP(pp_print)
 {
     dVAR; dSP; dMARK; dORIGMARK;
 PP(pp_print)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    register PerlIO *fp;
+    PerlIO *fp;
     MAGIC *mg;
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
     MAGIC *mg;
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
@@ -768,42 +772,16 @@ PP(pp_rv2av)
     if (SvROK(sv)) {
        if (SvAMAGIC(sv)) {
            sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
     if (SvROK(sv)) {
        if (SvAMAGIC(sv)) {
            sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
-           SPAGAIN;
        }
        sv = SvRV(sv);
        if (SvTYPE(sv) != type)
        }
        sv = SvRV(sv);
        if (SvTYPE(sv) != type)
+           /* diag_listed_as: Not an ARRAY reference */
            DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
            DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
-       if (PL_op->op_flags & OPf_REF) {
-           SETs(sv);
-           RETURN;
-       }
-       else if (PL_op->op_private & OPpMAYBE_LVSUB) {
-         const I32 flags = is_lvalue_sub();
-         if (flags && !(flags & OPpENTERSUB_INARGS)) {
-           if (gimme != G_ARRAY)
-               goto croak_cant_return;
-           SETs(sv);
-           RETURN;
-         }
-       }
        else if (PL_op->op_flags & OPf_MOD
                && PL_op->op_private & OPpLVAL_INTRO)
            Perl_croak(aTHX_ "%s", PL_no_localize_ref);
     }
        else if (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) {
-           if (PL_op->op_flags & OPf_REF) {
-               SETs(sv);
-               RETURN;
-           }
-           else if (LVRET) {
-               if (gimme != G_ARRAY)
-                   goto croak_cant_return;
-               SETs(sv);
-               RETURN;
-           }
-       }
-       else {
+    else if (SvTYPE(sv) != type) {
            GV *gv;
        
            if (!isGV_with_GP(sv)) {
            GV *gv;
        
            if (!isGV_with_GP(sv)) {
@@ -818,11 +796,12 @@ PP(pp_rv2av)
            sv = is_pp_rv2av ? MUTABLE_SV(GvAVn(gv)) : MUTABLE_SV(GvHVn(gv));
            if (PL_op->op_private & OPpLVAL_INTRO)
                sv = is_pp_rv2av ? MUTABLE_SV(save_ary(gv)) : MUTABLE_SV(save_hash(gv));
            sv = is_pp_rv2av ? MUTABLE_SV(GvAVn(gv)) : MUTABLE_SV(GvHVn(gv));
            if (PL_op->op_private & OPpLVAL_INTRO)
                sv = is_pp_rv2av ? MUTABLE_SV(save_ary(gv)) : MUTABLE_SV(save_hash(gv));
-           if (PL_op->op_flags & OPf_REF) {
+    }
+    if (PL_op->op_flags & OPf_REF) {
                SETs(sv);
                RETURN;
                SETs(sv);
                RETURN;
-           }
-           else if (PL_op->op_private & OPpMAYBE_LVSUB) {
+    }
+    else if (PL_op->op_private & OPpMAYBE_LVSUB) {
              const I32 flags = is_lvalue_sub();
              if (flags && !(flags & OPpENTERSUB_INARGS)) {
                if (gimme != G_ARRAY)
              const I32 flags = is_lvalue_sub();
              if (flags && !(flags & OPpENTERSUB_INARGS)) {
                if (gimme != G_ARRAY)
@@ -830,8 +809,6 @@ PP(pp_rv2av)
                SETs(sv);
                RETURN;
              }
                SETs(sv);
                RETURN;
              }
-           }
-       }
     }
 
     if (is_pp_rv2av) {
     }
 
     if (is_pp_rv2av) {
@@ -869,6 +846,11 @@ PP(pp_rv2av)
            *PL_stack_sp = sv;
            return Perl_do_kv(aTHX);
        }
            *PL_stack_sp = sv;
            return Perl_do_kv(aTHX);
        }
+       else if ((PL_op->op_private & OPpTRUEBOOL
+             || (  PL_op->op_private & OPpMAYBE_TRUEBOOL
+                && block_gimme() == G_VOID  ))
+             && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied)))
+           SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
        else if (gimme == G_SCALAR) {
            dTARGET;
            TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
        else if (gimme == G_SCALAR) {
            dTARGET;
            TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
@@ -929,11 +911,11 @@ PP(pp_aassign)
     SV **firstrelem = PL_stack_base + POPMARK + 1;
     SV **firstlelem = lastrelem + 1;
 
     SV **firstrelem = PL_stack_base + POPMARK + 1;
     SV **firstlelem = lastrelem + 1;
 
-    register SV **relem;
-    register SV **lelem;
+    SV **relem;
+    SV **lelem;
 
 
-    register SV *sv;
-    register AV *ary;
+    SV *sv;
+    AV *ary;
 
     I32 gimme;
     HV *hash;
 
     I32 gimme;
     HV *hash;
@@ -992,6 +974,8 @@ PP(pp_aassign)
        case SVt_PVAV:
            ary = MUTABLE_AV(sv);
            magic = SvMAGICAL(ary) != 0;
        case SVt_PVAV:
            ary = MUTABLE_AV(sv);
            magic = SvMAGICAL(ary) != 0;
+           ENTER;
+           SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
            av_clear(ary);
            av_extend(ary, lastrelem - relem);
            i = 0;
            av_clear(ary);
            av_extend(ary, lastrelem - relem);
            i = 0;
@@ -1012,6 +996,7 @@ PP(pp_aassign)
            }
            if (PL_delaymagic & DM_ARRAY_ISA)
                SvSETMAGIC(MUTABLE_SV(ary));
            }
            if (PL_delaymagic & DM_ARRAY_ISA)
                SvSETMAGIC(MUTABLE_SV(ary));
+           LEAVE;
            break;
        case SVt_PVHV: {                                /* normal hash */
                SV *tmpstr;
            break;
        case SVt_PVHV: {                                /* normal hash */
                SV *tmpstr;
@@ -1019,6 +1004,8 @@ PP(pp_aassign)
 
                hash = MUTABLE_HV(sv);
                magic = SvMAGICAL(hash) != 0;
 
                hash = MUTABLE_HV(sv);
                magic = SvMAGICAL(hash) != 0;
+               ENTER;
+               SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
                hv_clear(hash);
                firsthashrelem = relem;
 
                hv_clear(hash);
                firsthashrelem = relem;
 
@@ -1055,6 +1042,7 @@ PP(pp_aassign)
                    do_oddball(hash, relem, firstrelem);
                    relem++;
                }
                    do_oddball(hash, relem, firstrelem);
                    relem++;
                }
+               LEAVE;
            }
            break;
        default:
            }
            break;
        default:
@@ -1082,71 +1070,77 @@ PP(pp_aassign)
        }
     }
     if (PL_delaymagic & ~DM_DELAY) {
        }
     }
     if (PL_delaymagic & ~DM_DELAY) {
+       /* Will be used to set PL_tainting below */
+       UV tmp_uid  = PerlProc_getuid();
+       UV tmp_euid = PerlProc_geteuid();
+       UV tmp_gid  = PerlProc_getgid();
+       UV tmp_egid = PerlProc_getegid();
+
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                           (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
+           (void)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
                            (Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
-           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                          (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
+           (void)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) {
 #  else
 #    ifdef HAS_SETRUID
            if ((PL_delaymagic & DM_UID) == DM_RUID) {
-               (void)setruid(PL_uid);
+               (void)setruid(PL_delaymagic_uid);
                PL_delaymagic &= ~DM_RUID;
            }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
            if ((PL_delaymagic & DM_UID) == DM_EUID) {
                PL_delaymagic &= ~DM_RUID;
            }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
            if ((PL_delaymagic & DM_UID) == DM_EUID) {
-               (void)seteuid(PL_euid);
+               (void)seteuid(PL_delaymagic_euid);
                PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
            if (PL_delaymagic & DM_UID) {
                PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
            if (PL_delaymagic & DM_UID) {
-               if (PL_uid != PL_euid)
+               if (PL_delaymagic_uid != PL_delaymagic_euid)
                    DIE(aTHX_ "No setreuid available");
                    DIE(aTHX_ "No setreuid available");
-               (void)PerlProc_setuid(PL_uid);
+               (void)PerlProc_setuid(PL_delaymagic_uid);
            }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
            }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-           PL_uid = PerlProc_getuid();
-           PL_euid = PerlProc_geteuid();
+           tmp_uid  = PerlProc_getuid();
+           tmp_euid = PerlProc_geteuid();
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                           (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
+           (void)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
                            (Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
-           (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                          (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
+           (void)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) {
 #  else
 #    ifdef HAS_SETRGID
            if ((PL_delaymagic & DM_GID) == DM_RGID) {
-               (void)setrgid(PL_gid);
+               (void)setrgid(PL_delaymagic_gid);
                PL_delaymagic &= ~DM_RGID;
            }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
            if ((PL_delaymagic & DM_GID) == DM_EGID) {
                PL_delaymagic &= ~DM_RGID;
            }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
            if ((PL_delaymagic & DM_GID) == DM_EGID) {
-               (void)setegid(PL_egid);
+               (void)setegid(PL_delaymagic_egid);
                PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
            if (PL_delaymagic & DM_GID) {
                PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
            if (PL_delaymagic & DM_GID) {
-               if (PL_gid != PL_egid)
+               if (PL_delaymagic_gid != PL_delaymagic_egid)
                    DIE(aTHX_ "No setregid available");
                    DIE(aTHX_ "No setregid available");
-               (void)PerlProc_setgid(PL_gid);
+               (void)PerlProc_setgid(PL_delaymagic_gid);
            }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
            }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-           PL_gid = PerlProc_getgid();
-           PL_egid = PerlProc_getegid();
+           tmp_gid  = PerlProc_getgid();
+           tmp_egid = PerlProc_getegid();
        }
        }
-       PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
+       PL_tainting |= (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid));
     }
     PL_delaymagic = 0;
 
     }
     PL_delaymagic = 0;
 
@@ -1192,10 +1186,12 @@ PP(pp_aassign)
 PP(pp_qr)
 {
     dVAR; dSP;
 PP(pp_qr)
 {
     dVAR; dSP;
-    register PMOP * const pm = cPMOP;
+    PMOP * const pm = cPMOP;
     REGEXP * rx = PM_GETRE(pm);
     SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
     SV * const rv = sv_newmortal();
     REGEXP * rx = PM_GETRE(pm);
     SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
     SV * const rv = sv_newmortal();
+    CV **cvp;
+    CV *cv;
 
     SvUPGRADE(rv, SVt_IV);
     /* For a subroutine describing itself as "This is a hacky workaround" I'm
 
     SvUPGRADE(rv, SVt_IV);
     /* For a subroutine describing itself as "This is a hacky workaround" I'm
@@ -1207,6 +1203,12 @@ PP(pp_qr)
     SvRV_set(rv, MUTABLE_SV(reg_temp_copy(NULL, rx)));
     SvROK_on(rv);
 
     SvRV_set(rv, MUTABLE_SV(reg_temp_copy(NULL, rx)));
     SvROK_on(rv);
 
+    cvp = &( ((struct regexp*)SvANY(SvRV(rv)))->qr_anoncv);
+    if ((cv = *cvp) && CvCLONE(*cvp)) {
+       *cvp = cv_clone(cv);
+       SvREFCNT_dec(cv);
+    }
+
     if (pkg) {
        HV *const stash = gv_stashsv(pkg, GV_ADD);
        SvREFCNT_dec(pkg);
     if (pkg) {
        HV *const stash = gv_stashsv(pkg, GV_ADD);
        SvREFCNT_dec(pkg);
@@ -1224,15 +1226,15 @@ PP(pp_qr)
 PP(pp_match)
 {
     dVAR; dSP; dTARG;
 PP(pp_match)
 {
     dVAR; dSP; dTARG;
-    register PMOP *pm = cPMOP;
+    PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
     PMOP *dynpm = pm;
-    register const char *t;
-    register const char *s;
+    const char *t;
+    const char *s;
     const char *strend;
     I32 global;
     U8 r_flags = REXEC_CHECKED;
     const char *truebase;                      /* Start of string  */
     const char *strend;
     I32 global;
     U8 r_flags = REXEC_CHECKED;
     const char *truebase;                      /* Start of string  */
-    register REGEXP *rx = PM_GETRE(pm);
+    REGEXP *rx = PM_GETRE(pm);
     bool rxtainted;
     const I32 gimme = GIMME;
     STRLEN len;
     bool rxtainted;
     const I32 gimme = GIMME;
     STRLEN len;
@@ -1274,7 +1276,9 @@ PP(pp_match)
         pm->op_pmflags & PMf_USED
 #endif
     ) {
         pm->op_pmflags & PMf_USED
 #endif
     ) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "?? already matched once"));
       failure:
       failure:
+
        if (gimme == G_ARRAY)
            RETURN;
        RETPUSHNO;
        if (gimme == G_ARRAY)
            RETURN;
        RETPUSHNO;
@@ -1288,8 +1292,10 @@ PP(pp_match)
        rx = PM_GETRE(pm);
     }
 
        rx = PM_GETRE(pm);
     }
 
-    if (RX_MINLEN(rx) > (I32)len)
+    if (RX_MINLEN(rx) > (I32)len) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
        goto failure;
        goto failure;
+    }
 
     truebase = t = s;
 
 
     truebase = t = s;
 
@@ -1322,14 +1328,14 @@ PP(pp_match)
            || SvTEMP(TARG) || SvAMAGIC(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
        r_flags |= REXEC_COPY_STR;
            || SvTEMP(TARG) || SvAMAGIC(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
        r_flags |= REXEC_COPY_STR;
-    if (SvSCREAM(TARG))
-       r_flags |= REXEC_SCREAM;
 
   play_it_again:
     if (global && RX_OFFS(rx)[0].start != -1) {
        t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
 
   play_it_again:
     if (global && RX_OFFS(rx)[0].start != -1) {
        t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
-       if ((s + RX_MINLEN(rx)) > strend || s < truebase)
+       if ((s + RX_MINLEN(rx)) > strend || s < truebase) {
+           DEBUG_r(PerlIO_printf(Perl_debug_log, "Regex match can't succeed, so not even tried\n"));
            goto nope;
            goto nope;
+       }
        if (update_minmatch++)
            minmatch = had_zerolen;
     }
        if (update_minmatch++)
            minmatch = had_zerolen;
     }
@@ -1344,9 +1350,6 @@ PP(pp_match)
        if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
             && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
        if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
             && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
-            && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
-                || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
-                     && (r_flags & REXEC_SCREAM)))
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
@@ -1381,7 +1384,10 @@ PP(pp_match)
                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)
                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)
-                   DIE(aTHX_ "panic: pp_match start/end pointers");
+                   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,
+                       (long)RX_OFFS(rx)[i].end, s, strend, (UV) len);
                sv_setpvn(*SP, s, len);
                if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
                sv_setpvn(*SP, s, len);
                if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
@@ -1509,9 +1515,9 @@ yup:                                      /* Confirmed by INTUIT */
        RX_OFFS(rx)[0].start = s - truebase;
        RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
     }
        RX_OFFS(rx)[0].start = s - truebase;
        RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
     }
-    /* including RX_NPARENS(rx) in the below code seems highly suspicious.
-       -dmq */
-    RX_NPARENS(rx) = RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;     /* used by @-, @+, and $^N */
+    /* match via INTUIT shouldn't have any captures. Let @-, @+, $^N know */
+    assert(!RX_NPARENS(rx));
+    RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -1534,12 +1540,12 @@ OP *
 Perl_do_readline(pTHX)
 {
     dVAR; dSP; dTARGETSTACKED;
 Perl_do_readline(pTHX)
 {
     dVAR; dSP; dTARGETSTACKED;
-    register SV *sv;
+    SV *sv;
     STRLEN tmplen = 0;
     STRLEN offset;
     PerlIO *fp;
     STRLEN tmplen = 0;
     STRLEN offset;
     PerlIO *fp;
-    register IO * const io = GvIO(PL_last_in_gv);
-    register const I32 type = PL_op->op_type;
+    IO * const io = GvIO(PL_last_in_gv);
+    const I32 type = PL_op->op_type;
     const I32 gimme = GIMME_V;
 
     if (io) {
     const I32 gimme = GIMME_V;
 
     if (io) {
@@ -1564,6 +1570,7 @@ Perl_do_readline(pTHX)
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
                        IoFLAGS(io) &= ~IOf_START;
                        do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL);
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
                        IoFLAGS(io) &= ~IOf_START;
                        do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL);
+                       SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */
                        sv_setpvs(GvSVn(PL_last_in_gv), "-");
                        SvSETMAGIC(GvSV(PL_last_in_gv));
                        fp = IoIFP(io);
                        sv_setpvs(GvSVn(PL_last_in_gv), "-");
                        SvSETMAGIC(GvSV(PL_last_in_gv));
                        fp = IoIFP(io);
@@ -1589,7 +1596,7 @@ Perl_do_readline(pTHX)
            && ckWARN2(WARN_GLOB, WARN_CLOSED))
        {
            if (type == OP_GLOB)
            && ckWARN2(WARN_GLOB, WARN_CLOSED))
        {
            if (type == OP_GLOB)
-               Perl_warner(aTHX_ packWARN(WARN_GLOB),
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
                            "glob failed (can't start child: %s)",
                            Strerror(errno));
            else
                            "glob failed (can't start child: %s)",
                            Strerror(errno));
            else
@@ -1612,12 +1619,12 @@ Perl_do_readline(pTHX)
            mg_get(sv);
        if (SvROK(sv)) {
            if (type == OP_RCATLINE)
            mg_get(sv);
        if (SvROK(sv)) {
            if (type == OP_RCATLINE)
-               SvPV_force_nolen(sv);
+               SvPV_force_nomg_nolen(sv);
            else
                sv_unref(sv);
        }
        else if (isGV_with_GP(sv)) {
            else
                sv_unref(sv);
        }
        else if (isGV_with_GP(sv)) {
-           SvPV_force_nolen(sv);
+           SvPV_force_nomg_nolen(sv);
        }
        SvUPGRADE(sv, SVt_PV);
        tmplen = SvLEN(sv);     /* remember if already alloced */
        }
        SvUPGRADE(sv, SVt_PV);
        tmplen = SvLEN(sv);     /* remember if already alloced */
@@ -1630,7 +1637,7 @@ Perl_do_readline(pTHX)
        offset = 0;
        if (type == OP_RCATLINE && SvOK(sv)) {
            if (!SvPOK(sv)) {
        offset = 0;
        if (type == OP_RCATLINE && SvOK(sv)) {
            if (!SvPOK(sv)) {
-               SvPV_force_nolen(sv);
+               SvPV_force_nomg_nolen(sv);
            }
            offset = SvCUR(sv);
        }
            }
            offset = SvCUR(sv);
        }
@@ -1702,7 +1709,7 @@ Perl_do_readline(pTHX)
                }
            }
            for (t1 = SvPVX_const(sv); *t1; t1++)
                }
            }
            for (t1 = SvPVX_const(sv); *t1; t1++)
-               if (!isALPHA(*t1) && !isDIGIT(*t1) &&
+               if (!isALNUMC(*t1) &&
                    strchr("$&*(){}[]'\";\\|?<>~`", *t1))
                        break;
            if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
                    strchr("$&*(){}[]'\";\\|?<>~`", *t1))
                        break;
            if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
@@ -1764,14 +1771,14 @@ PP(pp_helem)
         * Try to preserve the existenceness of a tied hash
         * element by using EXISTS and DELETE if possible.
         * Fallback to FETCH and STORE otherwise. */
         * Try to preserve the existenceness of a tied hash
         * element by using EXISTS and DELETE if possible.
         * Fallback to FETCH and STORE otherwise. */
-       if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+       if (SvCANEXISTDELETE(hv))
            preeminent = hv_exists_ent(hv, keysv, 0);
     }
 
     he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
     svp = he ? &HeVAL(he) : NULL;
     if (lval) {
            preeminent = hv_exists_ent(hv, keysv, 0);
     }
 
     he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
     svp = he ? &HeVAL(he) : NULL;
     if (lval) {
-       if (!svp || *svp == &PL_sv_undef) {
+       if (!svp || !*svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
            if (!defer) {
            SV* lv;
            SV* key2;
            if (!defer) {
@@ -1801,7 +1808,7 @@ PP(pp_helem)
            RETURN;
        }
     }
            RETURN;
        }
     }
-    sv = (svp ? *svp : &PL_sv_undef);
+    sv = (svp && *svp ? *svp : &PL_sv_undef);
     /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
      * was to make C<local $tied{foo} = $tied{foo}> possible.
      * However, it seems no longer to be needed for that purpose, and
     /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
      * was to make C<local $tied{foo} = $tied{foo}> possible.
      * However, it seems no longer to be needed for that purpose, and
@@ -1823,7 +1830,7 @@ PP(pp_helem)
 PP(pp_iter)
 {
     dVAR; dSP;
 PP(pp_iter)
 {
     dVAR; dSP;
-    register PERL_CONTEXT *cx;
+    PERL_CONTEXT *cx;
     SV *sv, *oldsv;
     SV **itersvp;
     AV *av = NULL; /* used for LOOP_FOR on arrays and the stack */
     SV *sv, *oldsv;
     SV **itersvp;
     AV *av = NULL; /* used for LOOP_FOR on arrays and the stack */
@@ -1832,7 +1839,7 @@ PP(pp_iter)
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
     if (!CxTYPE_is_LOOP(cx))
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
     if (!CxTYPE_is_LOOP(cx))
-       DIE(aTHX_ "panic: pp_iter");
+       DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx));
 
     itersvp = CxITERVAR(cx);
     if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
 
     itersvp = CxITERVAR(cx);
     if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
@@ -1873,7 +1880,7 @@ PP(pp_iter)
        /* don't risk potential race */
        if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
            /* safe to reuse old SV */
        /* don't risk potential race */
        if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
            /* safe to reuse old SV */
-           sv_setiv(*itersvp, cx->blk_loop.state_u.lazyiv.cur++);
+           sv_setiv(*itersvp, cx->blk_loop.state_u.lazyiv.cur);
        }
        else
        {
        }
        else
        {
@@ -1881,17 +1888,15 @@ PP(pp_iter)
             * completely new SV for closures/references to work as they
             * used to */
            oldsv = *itersvp;
             * completely new SV for closures/references to work as they
             * used to */
            oldsv = *itersvp;
-           *itersvp = newSViv(cx->blk_loop.state_u.lazyiv.cur++);
+           *itersvp = newSViv(cx->blk_loop.state_u.lazyiv.cur);
            SvREFCNT_dec(oldsv);
        }
 
            SvREFCNT_dec(oldsv);
        }
 
-       /* Handle end of range at IV_MAX */
-       if ((cx->blk_loop.state_u.lazyiv.cur == IV_MIN) &&
-           (cx->blk_loop.state_u.lazyiv.end == IV_MAX))
-       {
-           cx->blk_loop.state_u.lazyiv.cur++;
-           cx->blk_loop.state_u.lazyiv.end++;
-       }
+       if (cx->blk_loop.state_u.lazyiv.cur == IV_MAX) {
+           /* Handle end of range at IV_MAX */
+           cx->blk_loop.state_u.lazyiv.end = IV_MIN;
+       } else
+           ++cx->blk_loop.state_u.lazyiv.cur;
 
        RETPUSHYES;
     }
 
        RETPUSHYES;
     }
@@ -1961,7 +1966,7 @@ PP(pp_iter)
 /*
 A description of how taint works in pattern matching and substitution.
 
 /*
 A description of how taint works in pattern matching and substitution.
 
-While the pattern is being assembled/concatenated and them compiled,
+While the pattern is being assembled/concatenated and then compiled,
 PL_tainted will get 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.
 PL_tainted will get 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.
@@ -2028,23 +2033,23 @@ pp_match is just a simpler version of the above.
 PP(pp_subst)
 {
     dVAR; dSP; dTARG;
 PP(pp_subst)
 {
     dVAR; dSP; dTARG;
-    register PMOP *pm = cPMOP;
+    PMOP *pm = cPMOP;
     PMOP *rpm = pm;
     PMOP *rpm = pm;
-    register char *s;
+    char *s;
     char *strend;
     char *strend;
-    register char *m;
+    char *m;
     const char *c;
     const char *c;
-    register char *d;
+    char *d;
     STRLEN clen;
     I32 iters = 0;
     I32 maxiters;
     STRLEN clen;
     I32 iters = 0;
     I32 maxiters;
-    register I32 i;
+    I32 i;
     bool once;
     U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits.
                        See "how taint works" above */
     char *orig;
     U8 r_flags;
     bool once;
     U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits.
                        See "how taint works" above */
     char *orig;
     U8 r_flags;
-    register REGEXP *rx = PM_GETRE(pm);
+    REGEXP *rx = PM_GETRE(pm);
     STRLEN len;
     int force_on_match = 0;
     const I32 oldsave = PL_savestack_ix;
     STRLEN len;
     int force_on_match = 0;
     const I32 oldsave = PL_savestack_ix;
@@ -2055,7 +2060,7 @@ PP(pp_subst)
 #endif
     SV *nsv = NULL;
     /* known replacement string? */
 #endif
     SV *nsv = NULL;
     /* known replacement string? */
-    register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
+    SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
 
     PERL_ASYNC_CHECK();
 
 
     PERL_ASYNC_CHECK();
 
@@ -2089,7 +2094,7 @@ PP(pp_subst)
 
   setup_match:
     s = SvPV_mutable(TARG, len);
 
   setup_match:
     s = SvPV_mutable(TARG, len);
-    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
+    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV || SvVOK(TARG))
        force_on_match = 1;
 
     /* only replace once? */
        force_on_match = 1;
 
     /* only replace once? */
@@ -2110,7 +2115,7 @@ PP(pp_subst)
 
   force_it:
     if (!pm || !s)
 
   force_it:
     if (!pm || !s)
-       DIE(aTHX_ "panic: pp_subst");
+       DIE(aTHX_ "panic: pp_subst, pm=%p, s=%p", pm, s);
 
     strend = s + len;
     slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
 
     strend = s + len;
     slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
@@ -2125,8 +2130,6 @@ PP(pp_subst)
     r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
               ? REXEC_COPY_STR : 0;
     r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand
            || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
               ? REXEC_COPY_STR : 0;
-    if (SvSCREAM(TARG))
-       r_flags |= REXEC_SCREAM;
 
     orig = m = s;
     if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
 
     orig = m = s;
     if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
@@ -2138,10 +2141,7 @@ PP(pp_subst)
        /* How to do it in subst? */
 /*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
        /* How to do it in subst? */
 /*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
-            && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY)
-            && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
-                || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
-                     && (r_flags & REXEC_SCREAM))))
+            && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY))
            goto yup;
 */
     }
            goto yup;
 */
     }
@@ -2222,7 +2222,6 @@ PP(pp_subst)
        }
        d = s;
        PL_curpm = pm;
        }
        d = s;
        PL_curpm = pm;
-       SvSCREAM_off(TARG);     /* disable possible screamer */
        if (once) {
            if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
                rxtainted |= SUBST_TAINT_PAT;
        if (once) {
            if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
                rxtainted |= SUBST_TAINT_PAT;
@@ -2313,7 +2312,7 @@ PP(pp_subst)
        dstr = newSVpvn_flags(m, s-m, SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
        PL_curpm = pm;
        if (!c) {
        dstr = newSVpvn_flags(m, s-m, SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
        PL_curpm = pm;
        if (!c) {
-           register PERL_CONTEXT *cx;
+           PERL_CONTEXT *cx;
            SPAGAIN;
            /* note that a whole bunch of local vars are saved here for
             * use by pp_substcont: here's a list of them in case you're
            SPAGAIN;
            /* note that a whole bunch of local vars are saved here for
             * use by pp_substcont: here's a list of them in case you're
@@ -2338,20 +2337,20 @@ PP(pp_subst)
            }
            m = RX_OFFS(rx)[0].start + orig;
            if (doutf8 && !SvUTF8(dstr))
            }
            m = RX_OFFS(rx)[0].start + orig;
            if (doutf8 && !SvUTF8(dstr))
-               sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+               sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv);
             else
             else
-               sv_catpvn(dstr, s, m-s);
+               sv_catpvn_nomg(dstr, s, m-s);
            s = RX_OFFS(rx)[0].end + orig;
            if (clen)
            s = RX_OFFS(rx)[0].end + orig;
            if (clen)
-               sv_catpvn(dstr, c, clen);
+               sv_catpvn_nomg(dstr, c, clen);
            if (once)
                break;
        } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                             TARG, NULL, r_flags));
        if (doutf8 && !DO_UTF8(TARG))
            if (once)
                break;
        } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                             TARG, NULL, r_flags));
        if (doutf8 && !DO_UTF8(TARG))
-           sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
+           sv_catpvn_nomg_utf8_upgrade(dstr, s, strend - s, nsv);
        else
        else
-           sv_catpvn(dstr, s, strend - s);
+           sv_catpvn_nomg(dstr, s, strend - s);
 
        if (rpm->op_pmflags & PMf_NONDESTRUCT) {
            /* From here on down we're using the copy, and leaving the original
 
        if (rpm->op_pmflags & PMf_NONDESTRUCT) {
            /* From here on down we're using the copy, and leaving the original
@@ -2475,7 +2474,7 @@ PP(pp_leavesub)
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
-    register PERL_CONTEXT *cx;
+    PERL_CONTEXT *cx;
     SV *sv;
 
     if (CxMULTICALL(&cxstack[cxstack_ix]))
     SV *sv;
 
     if (CxMULTICALL(&cxstack[cxstack_ix]))
@@ -2489,7 +2488,8 @@ PP(pp_leavesub)
        MARK = newsp + 1;
        if (MARK <= SP) {
            if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
        MARK = newsp + 1;
        if (MARK <= SP) {
            if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-               if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
+               if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
+                    && !SvMAGICAL(TOPs)) {
                    *MARK = SvREFCNT_inc(TOPs);
                    FREETMPS;
                    sv_2mortal(*MARK);
                    *MARK = SvREFCNT_inc(TOPs);
                    FREETMPS;
                    sv_2mortal(*MARK);
@@ -2501,7 +2501,8 @@ PP(pp_leavesub)
                    SvREFCNT_dec(sv);
                }
            }
                    SvREFCNT_dec(sv);
                }
            }
-           else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
+           else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
+                    && !SvMAGICAL(TOPs)) {
                *MARK = TOPs;
            }
            else
                *MARK = TOPs;
            }
            else
@@ -2515,7 +2516,8 @@ PP(pp_leavesub)
     }
     else if (gimme == G_ARRAY) {
        for (MARK = newsp + 1; MARK <= SP; MARK++) {
     }
     else if (gimme == G_ARRAY) {
        for (MARK = newsp + 1; MARK <= SP; MARK++) {
-           if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1) {
+           if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1
+                || SvMAGICAL(*MARK)) {
                *MARK = sv_mortalcopy(*MARK);
                TAINT_NOT;      /* Each item is independent */
            }
                *MARK = sv_mortalcopy(*MARK);
                TAINT_NOT;      /* Each item is independent */
            }
@@ -2536,8 +2538,8 @@ PP(pp_entersub)
 {
     dVAR; dSP; dPOPss;
     GV *gv;
 {
     dVAR; dSP; dPOPss;
     GV *gv;
-    register CV *cv;
-    register PERL_CONTEXT *cx;
+    CV *cv;
+    PERL_CONTEXT *cx;
     I32 gimme;
     const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
 
     I32 gimme;
     const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
 
@@ -2546,8 +2548,6 @@ PP(pp_entersub)
     switch (SvTYPE(sv)) {
        /* This is overwhelming the most common case:  */
     case SVt_PVGV:
     switch (SvTYPE(sv)) {
        /* This is overwhelming the most common case:  */
     case SVt_PVGV:
-       if (!isGV_with_GP(sv))
-           DIE(aTHX_ "Not a CODE reference");
       we_have_a_glob:
        if (!(cv = GvCVu((const GV *)sv))) {
            HV *stash;
       we_have_a_glob:
        if (!(cv = GvCVu((const GV *)sv))) {
            HV *stash;
@@ -2580,11 +2580,11 @@ PP(pp_entersub)
        else {
            const char *sym;
            STRLEN len;
        else {
            const char *sym;
            STRLEN len;
-           sym = SvPV_nomg_const(sv, len);
-           if (!sym)
+           if (!SvOK(sv))
                DIE(aTHX_ PL_no_usym, "a subroutine");
                DIE(aTHX_ PL_no_usym, "a subroutine");
+           sym = SvPV_nomg_const(sv, len);
            if (PL_op->op_private & HINT_STRICT_REFS)
            if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(aTHX_ "Can't use string (\"%.32s\"%s) as a subroutine ref while \"strict refs\" in use", sym, len>32 ? "..." : "");
+               DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
            cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
            break;
        }
            cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
            break;
        }
@@ -2622,20 +2622,20 @@ PP(pp_entersub)
        /* should call AUTOLOAD now? */
        else {
 try_autoload:
        /* should call AUTOLOAD now? */
        else {
 try_autoload:
-           if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
-                                  FALSE)))
+           if ((autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+                                  GvNAMEUTF8(gv) ? SVf_UTF8 : 0)))
            {
                cv = GvCV(autogv);
            }
            {
                cv = GvCV(autogv);
            }
-           /* sorry */
            else {
            else {
+              sorry:
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, NULL);
                DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
            }
        }
        if (!cv)
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, NULL);
                DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
            }
        }
        if (!cv)
-           DIE(aTHX_ "Not a CODE reference");
+           goto sorry;
        goto retry;
     }
 
        goto retry;
     }
 
@@ -2660,17 +2660,12 @@ try_autoload:
     if (!(CvISXSUB(cv))) {
        /* This path taken at least 75% of the time   */
        dMARK;
     if (!(CvISXSUB(cv))) {
        /* This path taken at least 75% of the time   */
        dMARK;
-       register I32 items = SP - MARK;
-       AV* const padlist = CvPADLIST(cv);
+       I32 items = SP - MARK;
+       PADLIST * const padlist = CvPADLIST(cv);
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
        cx->blk_sub.retop = PL_op->op_next;
        CvDEPTH(cv)++;
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
        cx->blk_sub.retop = PL_op->op_next;
        CvDEPTH(cv)++;
-       /* XXX This would be a natural place to set C<PL_compcv = cv> so
-        * that eval'' ops within this sub know the correct lexical space.
-        * Owing the speed considerations, we choose instead to search for
-        * the cv using find_runcv() when calling doeval().
-        */
        if (CvDEPTH(cv) >= 2) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv));
        if (CvDEPTH(cv) >= 2) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv));
@@ -2714,6 +2709,9 @@ try_autoload:
                MARK++;
            }
        }
                MARK++;
            }
        }
+       if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
+           !CvLVALUE(cv))
+           DIE(aTHX_ "Can't modify non-lvalue subroutine call");
        /* warning must come *after* we fully set up the context
         * stuff so that __WARN__ handlers can safely dounwind()
         * if they want to
        /* warning must come *after* we fully set up the context
         * stuff so that __WARN__ handlers can safely dounwind()
         * if they want to
@@ -2885,6 +2883,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
        }
        SvROK_on(sv);
        SvSETMAGIC(sv);
        }
        SvROK_on(sv);
        SvSETMAGIC(sv);
+       SvGETMAGIC(sv);
     }
     if (SvGMAGICAL(sv)) {
        /* copy the sv without magic to prevent magic from being
     }
     if (SvGMAGICAL(sv)) {
        /* copy the sv without magic to prevent magic from being
@@ -2930,10 +2929,12 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     SV* ob;
     GV* gv;
     HV* stash;
     SV* ob;
     GV* gv;
     HV* stash;
-    const char* packname = NULL;
     SV *packsv = NULL;
     SV *packsv = NULL;
-    STRLEN packlen;
-    SV * const sv = *(PL_stack_base + TOPMARK + 1);
+    SV * const sv = PL_stack_base + TOPMARK == PL_stack_sp
+       ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a "
+                           "package or object reference", SVfARG(meth)),
+          (SV *)NULL)
+       : *(PL_stack_base + TOPMARK + 1);
 
     PERL_ARGS_ASSERT_METHOD_COMMON;
 
 
     PERL_ARGS_ASSERT_METHOD_COMMON;
 
@@ -2946,6 +2947,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
        ob = MUTABLE_SV(SvRV(sv));
     else {
        GV* iogv;
        ob = MUTABLE_SV(SvRV(sv));
     else {
        GV* iogv;
+        STRLEN packlen;
+        const char * packname = NULL;
        bool packname_is_utf8 = FALSE;
 
        /* this isn't a reference */
        bool packname_is_utf8 = FALSE;
 
        /* this isn't a reference */
@@ -2973,21 +2976,23 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
            if (!packname ||
                ((UTF8_IS_START(*packname) && DO_UTF8(sv))
                    ? !isIDFIRST_utf8((U8*)packname)
            if (!packname ||
                ((UTF8_IS_START(*packname) && DO_UTF8(sv))
                    ? !isIDFIRST_utf8((U8*)packname)
-                   : !isIDFIRST(*packname)
+                   : !isIDFIRST_L1((U8)*packname)
                ))
            {
                ))
            {
+               /* diag_listed_as: Can't call method "%s" without a package or object reference */
                Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
                           SVfARG(meth),
                           SvOK(sv) ? "without a package or object reference"
                                    : "on an undefined value");
            }
            /* assume it's a package name */
                Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
                           SVfARG(meth),
                           SvOK(sv) ? "without a package or object reference"
                                    : "on an undefined value");
            }
            /* assume it's a package name */
-           stash = gv_stashpvn(packname, packlen, 0);
+           stash = gv_stashpvn(packname, packlen, packname_is_utf8 ? SVf_UTF8 : 0);
            if (!stash)
                packsv = sv;
             else {
                SV* const ref = newSViv(PTR2IV(stash));
            if (!stash)
                packsv = sv;
             else {
                SV* const ref = newSViv(PTR2IV(stash));
-               (void)hv_store(PL_stashcache, packname, packlen, ref, 0);
+               (void)hv_store(PL_stashcache, packname,
+                                packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0);
            }
            goto fetch;
        }
            }
            goto fetch;
        }
@@ -3002,10 +3007,10 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                     && (ob = MUTABLE_SV(GvIO((const GV *)ob)))
                     && SvOBJECT(ob))))
     {
                     && (ob = MUTABLE_SV(GvIO((const GV *)ob)))
                     && SvOBJECT(ob))))
     {
-       const char * const name = SvPV_nolen_const(meth);
-       Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
-                  (SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" :
-                  name);
+       Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference",
+                  SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa"))
+                                        ? newSVpvs_flags("DOES", SVs_TEMP)
+                                        : meth));
     }
 
     stash = SvSTASH(ob);
     }
 
     stash = SvSTASH(ob);
@@ -3026,9 +3031,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
        }
     }
 
        }
     }
 
-    gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv),
-                             SvPV_nolen_const(meth),
-                             GV_AUTOLOAD | GV_CROAK);
+    gv = gv_fetchmethod_sv_flags(stash ? stash : MUTABLE_HV(packsv),
+                                    meth, GV_AUTOLOAD | GV_CROAK);
 
     assert(gv);
 
 
     assert(gv);
 
@@ -3039,8 +3043,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */
  */
Unnamed repository; edit this file 'description' to name the repository.