This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlapi: Remove per-thread section; move to real scns
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 315ec49..e849d0f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -20,7 +20,7 @@
  */
 
 /*
  */
 
 /*
-=head1 GV Functions
+=head1 GV Handling
 A GV is a structure which corresponds to to a Perl typeglob, ie *foo.
 It is a structure that holds a pointer to a scalar, an array, a hash etc,
 corresponding to $foo, @foo, %foo.
 A GV is a structure which corresponds to to a Perl typeglob, ie *foo.
 It is a structure that holds a pointer to a scalar, an array, a hash etc,
 corresponding to $foo, @foo, %foo.
@@ -28,6 +28,8 @@ corresponding to $foo, @foo, %foo.
 GVs are usually found as values in stashes (symbol table hashes) where
 Perl stores its global variables.
 
 GVs are usually found as values in stashes (symbol table hashes) where
 Perl stores its global variables.
 
+=for apidoc Ayh||GV
+
 =cut
 */
 
 =cut
 */
 
@@ -83,8 +85,8 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
     if (!*where)
     {
        *where = newSV_type(type);
     if (!*where)
     {
        *where = newSV_type(type);
-           if (type == SVt_PVAV && GvNAMELEN(gv) == 3
-            && strEQs(GvNAME(gv), "ISA"))
+           if (type == SVt_PVAV
+            && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
            sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     }
     return gv;
            sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     }
     return gv;
@@ -168,7 +170,6 @@ Perl_newGP(pTHX_ GV *const gv)
 #ifndef USE_ITHREADS
     GV *filegv;
 #endif
 #ifndef USE_ITHREADS
     GV *filegv;
 #endif
-    dVAR;
 
     PERL_ARGS_ASSERT_NEWGP;
     Newxz(gp, 1, GP);
 
     PERL_ARGS_ASSERT_NEWGP;
     Newxz(gp, 1, GP);
@@ -323,6 +324,8 @@ the return value of SvUTF8(sv).  It can also take the
 C<GV_ADDMULTI> flag, which means to pretend that the GV has been
 seen before (i.e., suppress "Used once" warnings).
 
 C<GV_ADDMULTI> flag, which means to pretend that the GV has been
 seen before (i.e., suppress "Used once" warnings).
 
+=for apidoc Amnh||GV_ADDMULTI
+
 =for apidoc gv_init
 
 The old form of C<gv_init_pvn()>.  It does not work with UTF-8 strings, as it
 =for apidoc gv_init
 
 The old form of C<gv_init_pvn()>.  It does not work with UTF-8 strings, as it
@@ -373,6 +376,9 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
     const U32 proto_utf8  = proto ? SvUTF8(gv) : 0;
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
     const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
     const U32 proto_utf8  = proto ? SvUTF8(gv) : 0;
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
     const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
+    const bool really_sub =
+       has_constant && SvTYPE(has_constant) == SVt_PVCV;
+    COP * const old = PL_curcop;
 
     PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
 
     PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
@@ -385,6 +391,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
        case SVt_PVIO:
             Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
                       sv_reftype(has_constant, 0));
        case SVt_PVIO:
             Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
                       sv_reftype(has_constant, 0));
+            NOT_REACHED; /* NOTREACHED */
             break;
 
        default: NOOP;
             break;
 
        default: NOOP;
@@ -410,14 +417,19 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
     SvIOK_off(gv);
     isGV_with_GP_on(gv);
 
     SvIOK_off(gv);
     isGV_with_GP_on(gv);
 
+    if (really_sub && !CvISXSUB(has_constant) && CvSTART(has_constant)
+     && (  CvSTART(has_constant)->op_type == OP_NEXTSTATE
+       || CvSTART(has_constant)->op_type == OP_DBSTATE))
+       PL_curcop = (COP *)CvSTART(has_constant);
     GvGP_set(gv, Perl_newGP(aTHX_ gv));
     GvGP_set(gv, Perl_newGP(aTHX_ gv));
+    PL_curcop = old;
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
     gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ));
     if (flags & GV_ADDMULTI || doproto)        /* doproto means it */
        GvMULTI_on(gv);                 /* _was_ mentioned */
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
     gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ));
     if (flags & GV_ADDMULTI || doproto)        /* doproto means it */
        GvMULTI_on(gv);                 /* _was_ mentioned */
-    if (has_constant && SvTYPE(has_constant) == SVt_PVCV) {
+    if (really_sub) {
        /* Not actually a constant.  Just a regular sub.  */
        CV * const cv = (CV *)has_constant;
        GvCV_set(gv,cv);
        /* Not actually a constant.  Just a regular sub.  */
        CV * const cv = (CV *)has_constant;
        GvCV_set(gv,cv);
@@ -516,9 +528,10 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
-    case KEY_given   : case KEY_goto   : case KEY_grep  :
-    case KEY_gt   : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
-    case KEY_local: case KEY_lt: case KEY_m   : case KEY_map : case KEY_my:
+    case KEY_given   : case KEY_goto   : case KEY_grep  : case KEY_gt     :
+    case KEY_if      : case KEY_isa    : case KEY_INIT  : case KEY_last   :
+    case KEY_le      : case KEY_local  : case KEY_lt    : case KEY_m      :
+    case KEY_map     : case KEY_my:
     case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
     case KEY_package: case KEY_print: case KEY_printf:
     case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
     case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
     case KEY_package: case KEY_print: case KEY_printf:
     case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
@@ -607,11 +620,12 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
        PL_compcv = oldcompcv;
     }
     if (cv) {
        PL_compcv = oldcompcv;
     }
     if (cv) {
-        SV *opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
-        cv_set_call_checker(
-          cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
-        );
-        SvREFCNT_dec(opnumsv);
+       SV *opnumsv = newSViv(
+           (opnum == OP_ENTEREVAL && len == 9 && memEQ(name, "evalbytes", 9)) ?
+               (OP_ENTEREVAL | (1<<16))
+           : opnum ? opnum : (((I32)name[2]) << 16));
+        cv_set_call_checker_flags(cv, Perl_ck_entersub_args_core, opnumsv, 0);
+       SvREFCNT_dec_NN(opnumsv);
     }
 
     return gv;
     }
 
     return gv;
@@ -637,7 +651,8 @@ Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
     STRLEN namelen;
     PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
     if (LIKELY(SvPOK_nog(namesv))) /* common case */
     STRLEN namelen;
     PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
     if (LIKELY(SvPOK_nog(namesv))) /* common case */
-        return gv_fetchmeth_internal(stash, namesv, NULL, 0, level, flags);
+        return gv_fetchmeth_internal(stash, namesv, NULL, 0, level,
+                                     flags | SvUTF8(namesv));
     namepv = SvPV(namesv, namelen);
     if (SvUTF8(namesv)) flags |= SVf_UTF8;
     return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
     namepv = SvPV(namesv, namelen);
     if (SvUTF8(namesv)) flags |= SVf_UTF8;
     return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
@@ -682,6 +697,8 @@ visible to Perl code.  So when calling C<call_sv>, you should not use
 the GV directly; instead, you should use the method's CV, which can be
 obtained from the GV with the C<GvCV> macro.
 
 the GV directly; instead, you should use the method's CV, which can be
 obtained from the GV with the C<GvCV> macro.
 
+=for apidoc Amnh||GV_SUPER
+
 =cut
 */
 
 =cut
 */
 
@@ -700,6 +717,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
+    STRLEN hvnamelen;
     I32 create = (level >= 0) ? HV_FETCH_LVALUE : 0;
     I32 items;
     U32 topgen_cmp;
     I32 create = (level >= 0) ? HV_FETCH_LVALUE : 0;
     I32 items;
     U32 topgen_cmp;
@@ -715,6 +733,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     assert(stash);
 
     hvname = HvNAME_get(stash);
     assert(stash);
 
     hvname = HvNAME_get(stash);
+    hvnamelen = HvNAMELEN_get(stash);
     if (!hvname)
       Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
 
     if (!hvname)
       Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
 
@@ -769,8 +788,8 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
             return 0;
         }
        else if (stash == cachestash
             return 0;
         }
        else if (stash == cachestash
-             && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
-              && strEQs(hvname, "CORE")
+             && len > 1 /* shortest is uc */
+              && memEQs(hvname, HvNAMELEN_get(stash), "CORE")
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
@@ -784,20 +803,42 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
         cstash = gv_stashsv(linear_sv, 0);
 
         if (!cstash) {
         cstash = gv_stashsv(linear_sv, 0);
 
         if (!cstash) {
-           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Can't locate package %" SVf " for @%" HEKf "::ISA",
-                          SVfARG(linear_sv),
-                           HEKfARG(HvNAME_HEK(stash)));
+            if ( ckWARN(WARN_SYNTAX)) {
+                if(     /* these are loaded from Perl_Gv_AMupdate() one way or another */
+                           ( len    && name[0] == '(' )  /* overload.pm related, in particular "()" */
+                        || ( memEQs( name, len, "DESTROY") )
+                ) {
+                     Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                            "Can't locate package %" SVf " for @%" HEKf "::ISA",
+                            SVfARG(linear_sv),
+                            HEKfARG(HvNAME_HEK(stash)));
+
+                } else if( memEQs( name, len, "AUTOLOAD") ) {
+                    /* gobble this warning */
+                } else {
+                    Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "While trying to resolve method call %.*s->%.*s()"
+                        " can not locate package \"%" SVf "\" yet it is mentioned in @%.*s::ISA"
+                        " (perhaps you forgot to load \"%" SVf "\"?)",
+                         (int) hvnamelen, hvname,
+                         (int) len, name,
+                        SVfARG(linear_sv),
+                         (int) hvnamelen, hvname,
+                         SVfARG(linear_sv));
+                }
+            }
             continue;
         }
 
         assert(cstash);
 
             continue;
         }
 
         assert(cstash);
 
-        gvp = (GV**)hv_fetch(cstash, name, is_utf8 ? -(I32)len : (I32)len, 0);
+        gvp = (GV**)hv_common(
+            cstash, meth, name, len, is_utf8 ? HVhek_UTF8 : 0, HV_FETCH_JUST_SV, NULL, 0
+        );
         if (!gvp) {
             if (len > 1 && HvNAMELEN_get(cstash) == 4) {
                 const char *hvname = HvNAME(cstash); assert(hvname);
         if (!gvp) {
             if (len > 1 && HvNAMELEN_get(cstash) == 4) {
                 const char *hvname = HvNAME(cstash); assert(hvname);
-                if (strEQs(hvname, "CORE")
+                if (strBEGINs(hvname, "CORE")
                  && (candidate =
                       S_maybe_add_coresub(aTHX_ cstash,NULL,name,len)
                     ))
                  && (candidate =
                       S_maybe_add_coresub(aTHX_ cstash,NULL,name,len)
                     ))
@@ -1063,7 +1104,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                         origname, HvENAME_get(stash), name) );
        }
         else if ( sep_len >= 7 &&
                         origname, HvENAME_get(stash), name) );
        }
         else if ( sep_len >= 7 &&
-                strEQs(last_separator - 7, "::SUPER")) {
+                strBEGINs(last_separator - 7, "::SUPER")) {
             /* don't autovifify if ->NoSuchStash::SUPER::method */
             stash = gv_stashpvn(origname, sep_len - 7, is_utf8);
            if (stash) flags |= GV_SUPER;
             /* don't autovifify if ->NoSuchStash::SUPER::method */
             stash = gv_stashpvn(origname, sep_len - 7, is_utf8);
            if (stash) flags |= GV_SUPER;
@@ -1080,9 +1121,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
        /* This is the special case that exempts Foo->import and
           Foo->unimport from being an error even if there's no
          import/unimport subroutine */
        /* This is the special case that exempts Foo->import and
           Foo->unimport from being an error even if there's no
          import/unimport subroutine */
-       if (strEQ(name,"import") || strEQ(name,"unimport"))
-           gv = MUTABLE_GV(&PL_sv_yes);
-       else if (autoload)
+       if (strEQ(name,"import") || strEQ(name,"unimport")) {
+           gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL,
+                                               NULL, 0, 0, NULL));
+       } else if (autoload)
            gv = gv_autoload_pvn(
                ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
            );
            gv = gv_autoload_pvn(
                ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
            );
@@ -1209,16 +1251,14 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
        return NULL;
 
     /*
        return NULL;
 
     /*
-     * Inheriting AUTOLOAD for non-methods works ... for now.
+     * Inheriting AUTOLOAD for non-methods no longer works
      */
     if (
         !(flags & GV_AUTOLOAD_ISMETHOD)
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
      */
     if (
         !(flags & GV_AUTOLOAD_ISMETHOD)
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Use of inherited AUTOLOAD for non-method %" SVf
-                        "::%" UTF8f "() is deprecated. This will be "
-                         "fatal in Perl 5.28",
+        Perl_croak(aTHX_ "Use of inherited AUTOLOAD for non-method %" SVf
+                         "::%" UTF8f "() is no longer allowed",
                         SVfARG(packname),
                          UTF8fARG(is_utf8, len, name));
 
                         SVfARG(packname),
                          UTF8fARG(is_utf8, len, name));
 
@@ -1254,7 +1294,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            if (SvUTF8(cv))
                sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2);
            ulen = SvCUR(tmpsv);
            if (SvUTF8(cv))
                sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2);
            ulen = SvCUR(tmpsv);
-           SvCUR(tmpsv)++; /* include null in string */
+           SvCUR_set(tmpsv, SvCUR(tmpsv) + 1); /* include null in string */
            sv_catpvn_flags(
                tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv)
            );
            sv_catpvn_flags(
                tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv)
            );
@@ -1262,8 +1302,8 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            sv_setsv_nomg((SV *)cv, tmpsv);
            SvTEMP_off(tmpsv);
            SvREFCNT_dec_NN(tmpsv);
            sv_setsv_nomg((SV *)cv, tmpsv);
            SvTEMP_off(tmpsv);
            SvREFCNT_dec_NN(tmpsv);
-           SvLEN(cv) = SvCUR(cv) + 1;
-           SvCUR(cv) = ulen;
+           SvLEN_set(cv, SvCUR(cv) + 1);
+           SvCUR_set(cv, ulen);
        }
        else {
          sv_setpvn((SV *)cv, name, len);
        }
        else {
          sv_setpvn((SV *)cv, name, len);
@@ -1338,13 +1378,19 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
       GV **gvp;
       dSP;
 
       GV **gvp;
       dSP;
 
+      PUSHSTACKi(PERLSI_MAGIC);
       ENTER;
 
       ENTER;
 
-#define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0)
+#define GET_HV_FETCH_TIE_FUNC                           \
+    (  (gvp = (GV **)hv_fetchs(stash, "_tie_it", 0))     \
+    && *gvp                                               \
+    && (  (isGV(*gvp) && GvCV(*gvp))                       \
+       || (SvROK(*gvp) && SvTYPE(SvRV(*gvp)) == SVt_PVCV)  ) \
+    )
 
       /* Load the module if it is not loaded.  */
       if (!(stash = gv_stashpvn(name, len, 0))
 
       /* Load the module if it is not loaded.  */
       if (!(stash = gv_stashpvn(name, len, 0))
-       || !(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+       || ! GET_HV_FETCH_TIE_FUNC)
       {
        SV * const module = newSVpvn(name, len);
        const char type = varname == '[' ? '$' : '%';
       {
        SV * const module = newSVpvn(name, len);
        const char type = varname == '[' ? '$' : '%';
@@ -1356,17 +1402,18 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
        if (!stash)
            Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available",
                    type, varname, name);
        if (!stash)
            Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available",
                    type, varname, name);
-       else if (!(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+       else if (! GET_HV_FETCH_TIE_FUNC)
            Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it",
                    type, varname, name);
       }
       /* Now call the tie function.  It should be in *gvp.  */
            Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it",
                    type, varname, name);
       }
       /* Now call the tie function.  It should be in *gvp.  */
-      assert(gvp); assert(*gvp); assert(GvCV(*gvp));
+      assert(gvp); assert(*gvp);
       PUSHMARK(SP);
       XPUSHs((SV *)gv);
       PUTBACK;
       call_sv((SV *)*gvp, G_VOID|G_DISCARD);
       LEAVE;
       PUSHMARK(SP);
       XPUSHs((SV *)gv);
       PUTBACK;
       call_sv((SV *)*gvp, G_VOID|G_DISCARD);
       LEAVE;
+      POPSTACK;
     }
 }
 
     }
 }
 
@@ -1417,6 +1464,13 @@ The most important of which are probably C<GV_ADD> and C<SVf_UTF8>.
 Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly
 recommended for performance reasons.
 
 Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly
 recommended for performance reasons.
 
+=for apidoc Amnh||GV_ADD
+=for apidoc Amnh||GV_NOADD_NOINIT
+=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOEXPAND
+=for apidoc Amnh||GV_ADDMG
+=for apidoc Amnh||SVf_UTF8
+
 =cut
 */
 
 =cut
 */
 
@@ -1470,11 +1524,11 @@ S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags)
 gv_stashsvpvn_cached
 
 Returns a pointer to the stash for a specified package, possibly
 gv_stashsvpvn_cached
 
 Returns a pointer to the stash for a specified package, possibly
-cached.  Implements both C<gv_stashpvn> and C<gv_stashsv>.
+cached.  Implements both C<L</gv_stashpvn>> and C<L</gv_stashsv>>.
 
 
-Requires one of either namesv or namepv to be non-null.
+Requires one of either C<namesv> or C<namepv> to be non-null.
 
 
-See C<L</gv_stashpvn>> for details on "flags".
+See C<L</gv_stashpvn>> for details on C<flags>.
 
 Note the sv interface is strongly preferred for performance reasons.
 
 
 Note the sv interface is strongly preferred for performance reasons.
 
@@ -1483,8 +1537,8 @@ Note the sv interface is strongly preferred for performance reasons.
 #define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED \
     assert(namesv || name)
 
 #define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED \
     assert(namesv || name)
 
-PERL_STATIC_INLINE HV*
-S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
+HV*
+Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
 {
     HV* stash;
     HE* he;
 {
     HV* stash;
     HE* he;
@@ -1552,12 +1606,10 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
     PERL_ARGS_ASSERT_GV_STASHSV;
     return gv_stashsvpvn_cached(sv, NULL, 0, flags);
 }
     PERL_ARGS_ASSERT_GV_STASHSV;
     return gv_stashsvpvn_cached(sv, NULL, 0, flags);
 }
-
-
 GV *
 GV *
-Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, const svtype sv_type) {
+Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 flags, const svtype sv_type) {
     PERL_ARGS_ASSERT_GV_FETCHPV;
     PERL_ARGS_ASSERT_GV_FETCHPV;
-    return gv_fetchpvn_flags(nambeg, strlen(nambeg), add, sv_type);
+    return gv_fetchpvn_flags(nambeg, strlen(nambeg), flags, sv_type);
 }
 
 GV *
 }
 
 GV *
@@ -1593,9 +1645,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                STRLEN *len, const char *nambeg, STRLEN full_len,
                const U32 is_utf8, const I32 add)
 {
                STRLEN *len, const char *nambeg, STRLEN full_len,
                const U32 is_utf8, const I32 add)
 {
+    char *tmpfullbuf = NULL; /* only malloc one big chunk of memory when the smallbuff is not large enough */
     const char *name_cursor;
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
     const char *name_cursor;
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
+    char smallbuf[64]; /* small buffer to avoid a malloc when possible */
 
     PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
     
 
     PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
     
@@ -1615,7 +1669,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
             if (!*stash)
                 *stash = PL_defstash;
             if (!*stash || !SvREFCNT(*stash)) /* symbol table under destruction */
             if (!*stash)
                 *stash = PL_defstash;
             if (!*stash || !SvREFCNT(*stash)) /* symbol table under destruction */
-                return FALSE;
+                goto notok;
 
             *len = name_cursor - *name;
             if (name_cursor > nambeg) { /* Skip for initial :: or ' */
 
             *len = name_cursor - *name;
             if (name_cursor > nambeg) { /* Skip for initial :: or ' */
@@ -1625,9 +1679,17 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                     key = *name;
                     *len += 2;
                 }
                     key = *name;
                     *len += 2;
                 }
-                else {
+                else { /* using ' for package separator */
+                    /* use our pre-allocated buffer when possible to save a malloc */
                     char *tmpbuf;
                     char *tmpbuf;
-                    Newx(tmpbuf, *len+2, char);
+                    if ( *len+2 <= sizeof smallbuf)
+                        tmpbuf = smallbuf;
+                    else {
+                        /* only malloc once if needed */
+                        if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */
+                            Newx(tmpfullbuf, full_len+2, char);
+                        tmpbuf = tmpfullbuf;
+                    }
                     Copy(*name, tmpbuf, *len, char);
                     tmpbuf[(*len)++] = ':';
                     tmpbuf[(*len)++] = ':';
                     Copy(*name, tmpbuf, *len, char);
                     tmpbuf[(*len)++] = ':';
                     tmpbuf[(*len)++] = ':';
@@ -1635,22 +1697,20 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 }
                 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
                 *gv = gvp ? *gvp : NULL;
                 }
                 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
                 *gv = gvp ? *gvp : NULL;
-                if (*gv && *gv != (const GV *)&PL_sv_undef) {
-                    if (SvTYPE(*gv) != SVt_PVGV)
-                        gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
-                    else
-                        GvMULTI_on(*gv);
+                if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+                    goto notok;
                 }
                 }
-                if (key != *name)
-                    Safefree(key);
-                if (!*gv || *gv == (const GV *)&PL_sv_undef)
-                    return FALSE;
+                /* here we know that *gv && *gv != &PL_sv_undef */
+                if (SvTYPE(*gv) != SVt_PVGV)
+                    gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+                else
+                    GvMULTI_on(*gv);
 
                 if (!(*stash = GvHV(*gv))) {
                     *stash = GvHV(*gv) = newHV();
                     if (!HvNAME_get(*stash)) {
                         if (GvSTASH(*gv) == PL_defstash && *len == 6
 
                 if (!(*stash = GvHV(*gv))) {
                     *stash = GvHV(*gv) = newHV();
                     if (!HvNAME_get(*stash)) {
                         if (GvSTASH(*gv) == PL_defstash && *len == 6
-                            && strEQs(*name, "CORE"))
+                            && strBEGINs(*name, "CORE"))
                             hv_name_sets(*stash, "CORE", 0);
                         else
                             hv_name_set(
                             hv_name_sets(*stash, "CORE", 0);
                         else
                             hv_name_set(
@@ -1679,14 +1739,20 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                            MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
                    }
                }
                            MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
                    }
                }
-                return TRUE;
+                goto ok;
             }
         }
     }
     *len = name_cursor - *name;
             }
         }
     }
     *len = name_cursor - *name;
+  ok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
     return TRUE;
     return TRUE;
+  notok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
+    return FALSE;
 }
 
 }
 
+
 /* Checks if an unqualified name is in the main stash */
 PERL_STATIC_INLINE bool
 S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
 /* Checks if an unqualified name is in the main stash */
 PERL_STATIC_INLINE bool
 S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
@@ -1851,7 +1917,7 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
  * a new GV.
  * Note that it does not insert the GV into the stash prior to
  * magicalization, which some variables require need in order
  * a new GV.
  * Note that it does not insert the GV into the stash prior to
  * magicalization, which some variables require need in order
- * to work (like $[, %+, %-, %!), so callers must take care of
+ * to work (like %+, %-, %!), so callers must take care of
  * that.
  * 
  * It returns true if the gv did turn out to be magical one; i.e.,
  * that.
  * 
  * It returns true if the gv did turn out to be magical one; i.e.,
@@ -1908,7 +1974,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
          /* Avoid null warning: */
          const char * const stashname = HvNAME(stash); assert(stashname);
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
          /* Avoid null warning: */
          const char * const stashname = HvNAME(stash); assert(stashname);
-         if (strEQs(stashname, "CORE"))
+         if (strBEGINs(stashname, "CORE"))
            S_maybe_add_coresub(aTHX_ 0, gv, name, len);
        }
     }
            S_maybe_add_coresub(aTHX_ 0, gv, name, len);
        }
     }
@@ -1994,18 +2060,16 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                                 /* @{^CAPTURE} %{^CAPTURE} */
                 if (memEQs(name, len, "\003APTURE")) {
                     AV* const av = GvAVn(gv);
                                 /* @{^CAPTURE} %{^CAPTURE} */
                 if (memEQs(name, len, "\003APTURE")) {
                     AV* const av = GvAVn(gv);
-                    UV uv= *name;
+                    const Size_t n = *name;
 
 
-                    sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0);
+                    sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                     SvREADONLY_on(av);
 
                     SvREADONLY_on(av);
 
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
 
                 } else          /* %{^CAPTURE_ALL} */
                 if (memEQs(name, len, "\003APTURE_ALL")) {
 
                 } else          /* %{^CAPTURE_ALL} */
                 if (memEQs(name, len, "\003APTURE_ALL")) {
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
                 }
                break;
            case '\005':        /* $^ENCODING */
                 }
                break;
            case '\005':        /* $^ENCODING */
@@ -2040,6 +2104,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                     goto storeparen;
                 }
                break;
                     goto storeparen;
                 }
                break;
+            case '\023':
+                if (memEQs(name, len, "\023AFE_LOCALES"))
+                   goto ro_magicalize;
+               break;
            case '\024':        /* ${^TAINT} */
                 if (memEQs(name, len, "\024AINT"))
                    goto ro_magicalize;
            case '\024':        /* ${^TAINT} */
                 if (memEQs(name, len, "\024AINT"))
                    goto ro_magicalize;
@@ -2162,33 +2230,24 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             }
             {   /* @- @+ */
                 AV* const av = GvAVn(gv);
             }
             {   /* @- @+ */
                 AV* const av = GvAVn(gv);
-                const UV uv = (UV)*name;
+                const Size_t n = *name;
 
 
-                sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0);
+                sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                 SvREADONLY_on(av);
             }
             break;
        case '*':               /* $* */
        case '#':               /* $# */
                 SvREADONLY_on(av);
             }
             break;
        case '*':               /* $* */
        case '#':               /* $# */
-           if (sv_type == SVt_PV)
-               /* diag_listed_as: $* is no longer supported. Its use will be fatal in Perl 5.30 */
-               Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$%c is no longer supported. Its use "
-                                 "will be fatal in Perl 5.30", *name);
-           break;
+        if (sv_type == SVt_PV)
+            /* diag_listed_as: $* is no longer supported as of Perl 5.30 */
+            Perl_croak(aTHX_ "$%c is no longer supported as of Perl 5.30", *name);
+        break;
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
                hv_magic(hv, NULL, PERL_MAGIC_hints);
            }
            goto magicalize;
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
                hv_magic(hv, NULL, PERL_MAGIC_hints);
            }
            goto magicalize;
-       case '[':               /* $[ */
-           if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
-            && FEATURE_ARYBASE_IS_ENABLED) {
-                require_tie_mod_s(gv,'[',"arybase",0);
-           }
-           else goto magicalize;
-            break;
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
@@ -2207,6 +2266,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '/':               /* $/ */
        case '|':               /* $| */
        case '$':               /* $$ */
        case '/':               /* $/ */
        case '|':               /* $| */
        case '$':               /* $$ */
+       case '[':               /* $[ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '\004':    /* $^D */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '\004':    /* $^D */
@@ -2284,18 +2344,12 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
             require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0);
     } else if (sv_type == SVt_PV) {
         if (*name == '*' || *name == '#') {
             require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0);
     } else if (sv_type == SVt_PV) {
         if (*name == '*' || *name == '#') {
-            /* diag_listed_as: $# is no longer supported. Its use will be fatal in Perl 5.30 */
-            Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
-                                             WARN_SYNTAX),
-                             "$%c is no longer supported. Its use "
-                             "will be fatal in Perl 5.30", *name);
+            /* diag_listed_as: $* is no longer supported as of Perl 5.30 */
+            Perl_croak(aTHX_ "$%c is no longer supported as of Perl 5.30", *name);
         }
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
         }
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
-      case '[':
-          require_tie_mod_s(gv,'[',"arybase",0);
-          break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
           PL_sawampersand |= SAWAMPERSAND_LEFT;
 #ifdef PERL_SAWAMPERSAND
       case '`':
           PL_sawampersand |= SAWAMPERSAND_LEFT;
@@ -2314,6 +2368,75 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
     }
 }
 
     }
 }
 
+/*
+=for apidoc gv_fetchpv
+=for apidoc_item |GV *|gv_fetchpvn|const char * nambeg|STRLEN full_len|I32 flags|const svtype sv_type
+=for apidoc_item ||gv_fetchpvn_flags
+=for apidoc_item |GV *|gv_fetchpvs|"name"|I32 flags|const svtype sv_type
+=for apidoc_item ||gv_fetchsv
+=for apidoc_item |GV *|gv_fetchsv_nomg|SV *name|I32 flags|const svtype sv_type
+
+These all return the GV of type C<sv_type> whose name is given by the inputs,
+or NULL if no GV of that name and type could be found.  See L<perlguts/Stashes
+and Globs>.
+
+The only differences are how the input name is specified, and if 'get' magic is
+normally used in getting that name.
+
+Don't be fooled by the fact that only one form has C<flags> in its name.  They
+all have a C<flags> parameter in fact, and all the flag bits have the same
+meanings for all
+
+If any of the flags C<GV_ADD>, C<GV_ADDMG>, C<GV_ADDWARN>, C<GV_ADDMULTI>, or
+C<GV_NOINIT> is set, a GV is created if none already exists for the input name
+and type.  However, C<GV_ADDMG> will only do the creation for magical GV's.
+For all of these flags except C<GV_NOINIT>, C<L</gv_init_pvn>> is called after
+the addition.  C<GV_ADDWARN> is used when the caller expects that adding won't
+be necessary because the symbol should already exist; but if not, add it
+anyway, with a warning that it was unexpectedly absent.  The C<GV_ADDMULTI>
+flag means to pretend that the GV has been seen before (I<i.e.>, suppress "Used
+once" warnings).
+
+The flag C<GV_NOADD_NOINIT> causes C<L</gv_init_pvn>> not be to called if the
+GV existed but isn't PVGV.
+
+If the C<SVf_UTF8> bit is set, the name is treated as being encoded in UTF-8;
+otherwise the name won't be considered to be UTF-8 in the C<pv>-named forms,
+and the UTF-8ness of the underlying SVs will be used in the C<sv> forms.
+
+If the flag C<GV_NOTQUAL> is set, the caller warrants that the input name is a
+plain symbol name, not qualified with a package, otherwise the name is checked
+for being a qualified one.
+
+In C<gv_fetchpv>, C<nambeg> is a C string, NUL-terminated with no intermediate
+NULs.
+
+In C<gv_fetchpvs>, C<name> is a literal C string, hence is enclosed in
+double quotes.
+
+C<gv_fetchpvn> and C<gv_fetchpvn_flags> are identical.  In these, <nambeg> is
+a Perl string whose byte length is given by C<full_len>, and may contain
+embedded NULs.
+
+In C<gv_fetchsv> and C<gv_fetchsv_nomg>, the name is extracted from the PV of
+the input C<name> SV.  The only difference between these two forms is that
+'get' magic is normally done on C<name> in C<gv_fetchsv>, and always skipped
+with C<gv_fetchsv_nomg>.  Including C<GV_NO_SVGMAGIC> in the C<flags> parameter
+to C<gv_fetchsv> makes it behave identically to C<gv_fetchsv_nomg>.
+
+=for apidoc Amnh||GV_ADD
+=for apidoc Amnh||GV_ADDMG
+=for apidoc Amnh||GV_ADDMULTI
+=for apidoc Amnh||GV_ADDWARN
+=for apidoc Amnh||GV_NOADD_NOINIT
+=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOTQUAL
+=for apidoc Amnh||GV_NO_SVGMAGIC
+=for apidoc Amnh||SVf_UTF8
+
+=cut
+*/
+
 GV *
 Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                       const svtype sv_type)
 GV *
 Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                       const svtype sv_type)
@@ -2355,7 +2478,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     /* By this point we should have a stash and a name */
     gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);
     if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
     /* By this point we should have a stash and a name */
     gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);
     if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
-       if (addmg) gv = (GV *)newSV(0);
+       if (addmg) gv = (GV *)newSV(0);     /* tentatively */
        else return NULL;
     }
     else gv = *gvp, addmg = 0;
        else return NULL;
     }
     else gv = *gvp, addmg = 0;
@@ -2384,8 +2507,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            if (len == 1 && stash == PL_defstash) {
                 maybe_multimagic_gv(gv, name, sv_type);
            }
            if (len == 1 && stash == PL_defstash) {
                 maybe_multimagic_gv(gv, name, sv_type);
            }
-           else if (len == 3 && sv_type == SVt_PVAV
-                 && strEQs(name, "ISA")
+            else if (sv_type == SVt_PVAV
+                 && memEQs(name, len, "ISA")
                  && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
                gv_magicalize_isa(gv);
        }
                  && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
                gv_magicalize_isa(gv);
        }
@@ -2461,7 +2584,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
 
     if (hv && (name = HvNAME(hv))) {
       const STRLEN len = HvNAMELEN(hv);
 
     if (hv && (name = HvNAME(hv))) {
       const STRLEN len = HvNAMELEN(hv);
-      if (keepmain || strnNE(name, "main", len)) {
+      if (keepmain || ! memBEGINs(name, len, "main")) {
        sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES);
        sv_catpvs(sv,"::");
       }
        sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES);
        sv_catpvs(sv,"::");
       }
@@ -2787,13 +2910,12 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
        gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
         cv = 0;
         if (gv && (cv = GvCV(gv)) && CvHASGV(cv)) {
        gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
         cv = 0;
         if (gv && (cv = GvCV(gv)) && CvHASGV(cv)) {
-            const HEK * const gvhek =
-                CvNAMED(cv) ? CvNAME_HEK(cv) : GvNAME_HEK(CvGV(cv));
+            const HEK * const gvhek = CvGvNAME_HEK(cv);
             const HEK * const stashek =
                 HvNAME_HEK(CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv)));
             const HEK * const stashek =
                 HvNAME_HEK(CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv)));
-            if (HEK_LEN(gvhek) == 3 && strEQ(HEK_KEY(gvhek), "nil")
-             && stashek && HEK_LEN(stashek) == 8
-             && strEQ(HEK_KEY(stashek), "overload")) {
+            if (memEQs(HEK_KEY(gvhek), HEK_LEN(gvhek), "nil")
+             && stashek
+             && memEQs(HEK_KEY(stashek), HEK_LEN(stashek), "overload")) {
                /* This is a hack to support autoloading..., while
                   knowing *which* methods were declared as overloaded. */
                /* GvSV contains the name of the method. */
                /* This is a hack to support autoloading..., while
                   knowing *which* methods were declared as overloaded. */
                /* GvSV contains the name of the method. */
@@ -2920,8 +3042,6 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 /* Implement tryAMAGICun_MG macro.
    Do get magic, then see if the stack arg is overloaded and if so call it.
    Flags:
 /* Implement tryAMAGICun_MG macro.
    Do get magic, then see if the stack arg is overloaded and if so call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_numeric apply sv_2num to the stack arg.
 */
 
        AMGf_numeric apply sv_2num to the stack arg.
 */
 
@@ -2937,18 +3057,21 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
                                              AMGf_noright | AMGf_unary
                                            | (flags & AMGf_numarg))))
     {
                                              AMGf_noright | AMGf_unary
                                            | (flags & AMGf_numarg))))
     {
-       if (flags & AMGf_set) {
-           SETs(tmpsv);
-       }
-       else {
-           dTARGET;
-           if (SvPADMY(TARG)) {
-               sv_setsv(TARG, tmpsv);
-               SETTARG;
-           }
-           else
-               SETs(tmpsv);
-       }
+        /* where the op is of the form:
+         *    $lex = $x op $y (where the assign is optimised away)
+         * then assign the returned value to targ and return that;
+         * otherwise return the value directly
+         */
+        if (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+            && (PL_op->op_private & OPpTARGET_MY))
+        {
+            dTARGET;
+            sv_setsv(TARG, tmpsv);
+            SETTARG;
+        }
+        else
+            SETs(tmpsv);
+
        PUTBACK;
        return TRUE;
     }
        PUTBACK;
        return TRUE;
     }
@@ -2963,8 +3086,6 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
    Do get magic, then see if the two stack args are overloaded and if so
    call it.
    Flags:
    Do get magic, then see if the two stack args are overloaded and if so
    call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_assign  op may be called as mutator (eg +=)
        AMGf_numeric apply sv_2num to the stack arg.
 */
        AMGf_assign  op may be called as mutator (eg +=)
        AMGf_numeric apply sv_2num to the stack arg.
 */
@@ -2980,28 +3101,38 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
        SvGETMAGIC(right);
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
        SvGETMAGIC(right);
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
-       SV * const tmpsv = amagic_call(left, right, method,
-                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+       SV * tmpsv;
+        /* STACKED implies mutator variant, e.g. $x += 1 */
+        bool mutator = (flags & AMGf_assign) && (PL_op->op_flags & OPf_STACKED);
+
+       tmpsv = amagic_call(left, right, method,
+                   (mutator ? AMGf_assign: 0)
                  | (flags & AMGf_numarg));
        if (tmpsv) {
                  | (flags & AMGf_numarg));
        if (tmpsv) {
-           if (flags & AMGf_set) {
-               (void)POPs;
-               SETs(tmpsv);
-           }
-           else {
-               dATARGET;
-               (void)POPs;
-               if (opASSIGN || SvPADMY(TARG)) {
-                   sv_setsv(TARG, tmpsv);
-                   SETTARG;
-               }
-               else
-                   SETs(tmpsv);
-           }
+            (void)POPs;
+            /* where the op is one of the two forms:
+             *    $x op= $y
+             *    $lex = $x op $y (where the assign is optimised away)
+             * then assign the returned value to targ and return that;
+             * otherwise return the value directly
+             */
+            if (   mutator
+                || (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+                    && (PL_op->op_private & OPpTARGET_MY)))
+            {
+                dTARG;
+                TARG = mutator ? *SP : PAD_SV(PL_op->op_targ);
+                sv_setsv(TARG, tmpsv);
+                SETTARG;
+            }
+            else
+                SETs(tmpsv);
+
            PUTBACK;
            return TRUE;
        }
     }
            PUTBACK;
            return TRUE;
        }
     }
+
     if(left==right && SvGMAGICAL(left)) {
        SV * const left = sv_newmortal();
        *(sp-1) = left;
     if(left==right && SvGMAGICAL(left)) {
        SV * const left = sv_newmortal();
        *(sp-1) = left;
@@ -3081,7 +3212,6 @@ Perl_amagic_is_enabled(pTHX_ int method)
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
-  dVAR;
   MAGIC *mg;
   CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
   MAGIC *mg;
   CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
@@ -3179,11 +3309,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
         case abs_amg:
           if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
               && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
         case abs_amg:
           if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
               && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
-            SV* const nullsv=sv_2mortal(newSViv(0));
+            SV* const nullsv=&PL_sv_zero;
             if (off1==lt_amg) {
               SV* const lessp = amagic_call(left,nullsv,
                                       lt_amg,AMGf_noright);
             if (off1==lt_amg) {
               SV* const lessp = amagic_call(left,nullsv,
                                       lt_amg,AMGf_noright);
-              logic = SvTRUE(lessp);
+              logic = SvTRUE_NN(lessp);
             } else {
               SV* const lessp = amagic_call(left,nullsv,
                                       ncmp_amg,AMGf_noright);
             } else {
               SV* const lessp = amagic_call(left,nullsv,
                                       ncmp_amg,AMGf_noright);
@@ -3203,7 +3333,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
         case neg_amg:
           if ((cv = cvp[off=subtr_amg])) {
             right = left;
         case neg_amg:
           if ((cv = cvp[off=subtr_amg])) {
             right = left;
-            left = sv_2mortal(newSViv(0));
+            left = &PL_sv_zero;
             lr = 1;
           }
           break;
             lr = 1;
           }
           break;
@@ -3451,7 +3581,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     SV* res;
     const bool oldcatch = CATCH_GET;
     I32 oldmark, nret;
     SV* res;
     const bool oldcatch = CATCH_GET;
     I32 oldmark, nret;
-    U8 gimme = force_scalar ? G_SCALAR : GIMME_V;
+                /* for multiconcat, we may call overload several times,
+                 * with the context of individual concats being scalar,
+                 * regardless of the overall context of the multiconcat op
+                 */
+    U8 gimme = (force_scalar || PL_op->op_type == OP_MULTICONCAT)
+                    ? G_SCALAR : GIMME_V;
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
@@ -3512,7 +3647,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
             res = &PL_sv_undef;
             SP = PL_stack_base + oldmark;
             break;
             res = &PL_sv_undef;
             SP = PL_stack_base + oldmark;
             break;
-        case G_ARRAY: {
+        case G_ARRAY:
             if (flags & AMGf_want_list) {
                 res = sv_2mortal((SV *)newAV());
                 av_extend((AV *)res, nret);
             if (flags & AMGf_want_list) {
                 res = sv_2mortal((SV *)newAV());
                 av_extend((AV *)res, nret);
@@ -3521,7 +3656,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                 break;
             }
             /* FALLTHROUGH */
                 break;
             }
             /* FALLTHROUGH */
-        }
         default:
             res = POPs;
             break;
         default:
             res = POPs;
             break;
@@ -3556,7 +3690,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       case dec_amg:
        SvSetSV(left,res); return left;
       case not_amg:
       case dec_amg:
        SvSetSV(left,res); return left;
       case not_amg:
-       ans=!SvTRUE(res); break;
+       ans=!SvTRUE_NN(res); break;
       default:
         ans=0; break;
       }
       default:
         ans=0; break;
       }
@@ -3575,7 +3709,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 void
 Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
 {
 void
 Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
 {
-    dVAR;
     U32 hash;
 
     PERL_ARGS_ASSERT_GV_NAME_SET;
     U32 hash;
 
     PERL_ARGS_ASSERT_GV_NAME_SET;