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
Convert another test to DebugWrap.
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 4751812..9de8886 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -16,7 +16,7 @@
  * history of Middle-earth and Over-heaven and of the Sundering Seas,'
  * laughed Pippin.
  *
  * history of Middle-earth and Over-heaven and of the Sundering Seas,'
  * laughed Pippin.
  *
- *     [p.599 of _The Lord of the Rings_, III/xi: "The Palantír"]
+ *     [p.599 of _The Lord of the Rings_, III/xi: "The Palantír"]
  */
 
 /*
  */
 
 /*
@@ -37,6 +37,7 @@ Perl stores its global variables.
 #include "perl.h"
 #include "overload.c"
 #include "keywords.h"
 #include "perl.h"
 #include "overload.c"
 #include "keywords.h"
+#include "feature.h"
 
 static const char S_autoload[] = "AUTOLOAD";
 static const STRLEN S_autolen = sizeof(S_autoload)-1;
 
 static const char S_autoload[] = "AUTOLOAD";
 static const STRLEN S_autolen = sizeof(S_autoload)-1;
@@ -59,18 +60,14 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
             * if it walks like a dirhandle, then let's assume that
             * this is a dirhandle.
             */
             * if it walks like a dirhandle, then let's assume that
             * this is a dirhandle.
             */
-           what = PL_op->op_type ==  OP_READDIR ||
-               PL_op->op_type ==  OP_TELLDIR ||
-               PL_op->op_type ==  OP_SEEKDIR ||
-               PL_op->op_type ==  OP_REWINDDIR ||
-               PL_op->op_type ==  OP_CLOSEDIR ?
+           what = OP_IS_DIRHOP(PL_op->op_type) ?
                "dirhandle" : "filehandle";
                "dirhandle" : "filehandle";
-           /* diag_listed_as: Bad symbol for filehandle */
        } else if (type == SVt_PVHV) {
            what = "hash";
        } else {
            what = type == SVt_PVAV ? "array" : "scalar";
        }
        } else if (type == SVt_PVHV) {
            what = "hash";
        } else {
            what = type == SVt_PVAV ? "array" : "scalar";
        }
+       /* diag_listed_as: Bad symbol for filehandle */
        Perl_croak(aTHX_ "Bad symbol for %s", what);
     }
 
        Perl_croak(aTHX_ "Bad symbol for %s", what);
     }
 
@@ -86,6 +83,9 @@ 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
+     && strnEQ(GvNAME(gv), "ISA", 3))
+       sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     return gv;
 }
 
     return gv;
 }
 
@@ -162,17 +162,37 @@ Perl_newGP(pTHX_ GV *const gv)
 {
     GP *gp;
     U32 hash;
 {
     GP *gp;
     U32 hash;
-#ifdef USE_ITHREADS
-    const char *const file
-       = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : "";
-    const STRLEN len = strlen(file);
-#else
-    SV *const temp_sv = CopFILESV(PL_curcop);
     const char *file;
     STRLEN len;
     const char *file;
     STRLEN len;
+#ifndef USE_ITHREADS
+    SV * temp_sv;
+#endif
 
     PERL_ARGS_ASSERT_NEWGP;
 
     PERL_ARGS_ASSERT_NEWGP;
+    Newxz(gp, 1, GP);
+    gp->gp_egv = gv; /* allow compiler to reuse gv after this */
+#ifndef PERL_DONT_CREATE_GVSV
+    gp->gp_sv = newSV(0);
+#endif
 
 
+#ifdef USE_ITHREADS
+    if (PL_curcop) {
+       gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+       if (CopFILE(PL_curcop)) {
+           file = CopFILE(PL_curcop);
+           len = strlen(file);
+       }
+       else goto no_file;
+    }
+    else {
+       no_file:
+       file = "";
+       len = 0;
+    }
+#else
+    if(PL_curcop)
+       gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+    temp_sv = CopFILESV(PL_curcop);
     if (temp_sv) {
        file = SvPVX(temp_sv);
        len = SvCUR(temp_sv);
     if (temp_sv) {
        file = SvPVX(temp_sv);
        len = SvCUR(temp_sv);
@@ -183,18 +203,7 @@ Perl_newGP(pTHX_ GV *const gv)
 #endif
 
     PERL_HASH(hash, file, len);
 #endif
 
     PERL_HASH(hash, file, len);
-
-    Newxz(gp, 1, GP);
-
-#ifndef PERL_DONT_CREATE_GVSV
-    gp->gp_sv = newSV(0);
-#endif
-
-    gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0;
-    /* XXX Ideally this cast would be replaced with a change to const char*
-       in the struct.  */
     gp->gp_file_hek = share_hek(file, len, hash);
     gp->gp_file_hek = share_hek(file, len, hash);
-    gp->gp_egv = gv;
     gp->gp_refcnt = 1;
 
     return gp;
     gp->gp_refcnt = 1;
 
     return gp;
@@ -207,6 +216,7 @@ void
 Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 {
     GV * const oldgv = CvGV(cv);
 Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 {
     GV * const oldgv = CvGV(cv);
+    HEK *hek;
     PERL_ARGS_ASSERT_CVGV_SET;
 
     if (oldgv == gv)
     PERL_ARGS_ASSERT_CVGV_SET;
 
     if (oldgv == gv)
@@ -221,8 +231,9 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
            sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
        }
     }
            sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
        }
     }
+    else if ((hek = CvNAME_HEK(cv))) unshare_hek(hek);
 
 
-    SvANY(cv)->xcv_gv = gv;
+    SvANY(cv)->xcv_gv_u.xcv_gv = gv;
     assert(!CvCVGV_RC(cv));
 
     if (!gv)
     assert(!CvCVGV_RC(cv));
 
     if (!gv)
@@ -252,18 +263,83 @@ Perl_cvstash_set(pTHX_ CV *cv, HV *st)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv));
 }
 
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv));
 }
 
+/*
+=for apidoc gv_init_pvn
+
+Converts a scalar into a typeglob.  This is an incoercible typeglob;
+assigning a reference to it will assign to one of its slots, instead of
+overwriting it as happens with typeglobs created by SvSetSV.  Converting
+any scalar that is SvOK() may produce unpredictable results and is reserved
+for perl's internal use.
+
+C<gv> is the scalar to be converted.
+
+C<stash> is the parent stash/package, if any.
+
+C<name> and C<len> give the name.  The name must be unqualified;
+that is, it must not include the package name.  If C<gv> is a
+stash element, it is the caller's responsibility to ensure that the name
+passed to this function matches the name of the element.  If it does not
+match, perl's internal bookkeeping will get out of sync.
+
+C<flags> can be set to SVf_UTF8 if C<name> is a UTF8 string, or
+the return value of SvUTF8(sv).  It can also take the
+GV_ADDMULTI flag, which means to pretend that the GV has been
+seen before (i.e., suppress "Used once" warnings).
+
+=for apidoc gv_init
+
+The old form of gv_init_pvn().  It does not work with UTF8 strings, as it
+has no flags parameter.  If the C<multi> parameter is set, the
+GV_ADDMULTI flag will be passed to gv_init_pvn().
+
+=for apidoc gv_init_pv
+
+Same as gv_init_pvn(), but takes a nul-terminated string for the name
+instead of separate char * and length parameters.
+
+=for apidoc gv_init_sv
+
+Same as gv_init_pvn(), but takes an SV * for the name instead of separate
+char * and length parameters.  C<flags> is currently unused.
+
+=cut
+*/
+
 void
 void
-Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
+Perl_gv_init_sv(pTHX_ GV *gv, HV *stash, SV* namesv, U32 flags)
+{
+   char *namepv;
+   STRLEN namelen;
+   PERL_ARGS_ASSERT_GV_INIT_SV;
+   namepv = SvPV(namesv, namelen);
+   if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+   gv_init_pvn(gv, stash, namepv, namelen, flags);
+}
+
+void
+Perl_gv_init_pv(pTHX_ GV *gv, HV *stash, const char *name, U32 flags)
+{
+   PERL_ARGS_ASSERT_GV_INIT_PV;
+   gv_init_pvn(gv, stash, name, strlen(name), flags);
+}
+
+void
+Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flags)
 {
     dVAR;
     const U32 old_type = SvTYPE(gv);
     const bool doproto = old_type > SVt_NULL;
 {
     dVAR;
     const U32 old_type = SvTYPE(gv);
     const bool doproto = old_type > SVt_NULL;
-    char * const proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
+    char * const proto = (doproto && SvPOK(gv))
+       ? ((void)(SvIsCOW(gv) && (sv_force_normal((SV *)gv), 0)), SvPVX(gv))
+       : NULL;
     const STRLEN protolen = proto ? SvCUR(gv) : 0;
     const STRLEN protolen = proto ? SvCUR(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;
 
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
     const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
 
-    PERL_ARGS_ASSERT_GV_INIT;
+    PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
 
     if (has_constant) {
     assert (!(proto && has_constant));
 
     if (has_constant) {
@@ -303,54 +379,39 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
-    gv_name_set(gv, name, len, GV_ADD);
-    if (multi || doproto)              /* doproto means it _was_ mentioned */
-       GvMULTI_on(gv);
-    if (doproto) {                     /* Replicate part of newSUB here. */
+    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 (doproto) {
        CV *cv;
        CV *cv;
-       ENTER;
        if (has_constant) {
        if (has_constant) {
-           char *name0 = NULL;
-           if (name[len])
-               /* newCONSTSUB doesn't take a len arg, so make sure we
-                * give it a \0-terminated string */
-               name0 = savepvn(name,len);
-
            /* newCONSTSUB takes ownership of the reference from us.  */
            /* newCONSTSUB takes ownership of the reference from us.  */
-           cv = newCONSTSUB(stash, (name0 ? name0 : name), has_constant);
+           cv = newCONSTSUB_flags(stash, name, len, flags, has_constant);
            /* In case op.c:S_process_special_blocks stole it: */
            if (!GvCV(gv))
                GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv));
            assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */
            /* In case op.c:S_process_special_blocks stole it: */
            if (!GvCV(gv))
                GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv));
            assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */
-           if (name0)
-               Safefree(name0);
            /* If this reference was a copy of another, then the subroutine
               must have been "imported", by a Perl space assignment to a GV
               from a reference to CV.  */
            if (exported_constant)
                GvIMPORTED_CV_on(gv);
            /* If this reference was a copy of another, then the subroutine
               must have been "imported", by a Perl space assignment to a GV
               from a reference to CV.  */
            if (exported_constant)
                GvIMPORTED_CV_on(gv);
+           CvSTASH_set(cv, PL_curstash); /* XXX Why is this needed? */
        } else {
        } else {
-           (void) start_subparse(0,0); /* Create empty CV in compcv. */
-           cv = PL_compcv;
-           GvCV_set(gv,cv);
+           cv = newSTUB(gv,1);
        }
        }
-       LEAVE;
-
-        mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */
-       CvGV_set(cv, gv);
-       CvFILE_set_from_cop(cv, PL_curcop);
-       CvSTASH_set(cv, PL_curstash);
        if (proto) {
            sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
                            SV_HAS_TRAILING_NUL);
        if (proto) {
            sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
                            SV_HAS_TRAILING_NUL);
+            if ( proto_utf8 ) SvUTF8_on(MUTABLE_SV(cv));
        }
     }
 }
 
 STATIC void
        }
     }
 }
 
 STATIC void
-S_gv_init_sv(pTHX_ GV *gv, const svtype sv_type)
+S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
 {
 {
-    PERL_ARGS_ASSERT_GV_INIT_SV;
+    PERL_ARGS_ASSERT_GV_INIT_SVTYPE;
 
     switch (sv_type) {
     case SVt_PVIO:
 
     switch (sv_type) {
     case SVt_PVIO:
@@ -378,9 +439,175 @@ S_gv_init_sv(pTHX_ GV *gv, const svtype sv_type)
     }
 }
 
     }
 }
 
+static void core_xsub(pTHX_ CV* cv);
+
+static GV *
+S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
+                          const char * const name, const STRLEN len)
+{
+    const int code = keyword(name, len, 1);
+    static const char file[] = __FILE__;
+    CV *cv, *oldcompcv = NULL;
+    int opnum = 0;
+    SV *opnumsv;
+    bool ampable = TRUE; /* &{}-able */
+    COP *oldcurcop = NULL;
+    yy_parser *oldparser = NULL;
+    I32 oldsavestack_ix = 0;
+
+    assert(gv || stash);
+    assert(name);
+
+    if (!code) return NULL; /* Not a keyword */
+    switch (code < 0 ? -code : code) {
+     /* no support for \&CORE::infix;
+        no support for funcs that do not parse like funcs */
+    case KEY___DATA__: case KEY___END__: case KEY_and: case KEY_AUTOLOAD:
+    case KEY_BEGIN   : case KEY_CHECK  : case KEY_cmp: case KEY_CORE    :
+    case KEY_default : case KEY_DESTROY:
+    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_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_qx   : case KEY_redo : case KEY_require: case KEY_return:
+    case KEY_s    : case KEY_say  : case KEY_sort   :
+    case KEY_state: case KEY_sub  :
+    case KEY_tr   : case KEY_UNITCHECK: case KEY_unless:
+    case KEY_until: case KEY_use  : case KEY_when     : case KEY_while :
+    case KEY_x    : case KEY_xor  : case KEY_y        :
+       return NULL;
+    case KEY_chdir:
+    case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete:
+    case KEY_each : case KEY_eof : case KEY_exec   : case KEY_exists:
+    case KEY_keys:
+    case KEY_lstat:
+    case KEY_pop:
+    case KEY_push:
+    case KEY_shift:
+    case KEY_splice: case KEY_split:
+    case KEY_stat:
+    case KEY_system:
+    case KEY_truncate: case KEY_unlink:
+    case KEY_unshift:
+    case KEY_values:
+       ampable = FALSE;
+    }
+    if (!gv) {
+       gv = (GV *)newSV(0);
+       gv_init(gv, stash, name, len, TRUE);
+    }
+    GvMULTI_on(gv);
+    if (ampable) {
+       ENTER;
+       oldcurcop = PL_curcop;
+       oldparser = PL_parser;
+       lex_start(NULL, NULL, 0);
+       oldcompcv = PL_compcv;
+       PL_compcv = NULL; /* Prevent start_subparse from setting
+                            CvOUTSIDE. */
+       oldsavestack_ix = start_subparse(FALSE,0);
+       cv = PL_compcv;
+    }
+    else {
+       /* Avoid calling newXS, as it calls us, and things start to
+          get hairy. */
+       cv = MUTABLE_CV(newSV_type(SVt_PVCV));
+       GvCV_set(gv,cv);
+       GvCVGEN(gv) = 0;
+       mro_method_changed_in(GvSTASH(gv));
+       CvISXSUB_on(cv);
+       CvXSUB(cv) = core_xsub;
+    }
+    CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
+                         from PL_curcop. */
+    (void)gv_fetchfile(file);
+    CvFILE(cv) = (char *)file;
+    /* XXX This is inefficient, as doing things this order causes
+           a prototype check in newATTRSUB.  But we have to do
+           it this order as we need an op number before calling
+           new ATTRSUB. */
+    (void)core_prototype((SV *)cv, name, code, &opnum);
+    if (stash)
+       (void)hv_store(stash,name,len,(SV *)gv,0);
+    if (ampable) {
+       CvLVALUE_on(cv);
+       newATTRSUB_flags(
+                  oldsavestack_ix, (OP *)gv,
+                  NULL,NULL,
+                  coresub_op(
+                    opnum
+                      ? newSVuv((UV)opnum)
+                      : newSVpvn(name,len),
+                    code, opnum
+                  ),
+                  1
+       );
+       assert(GvCV(gv) == cv);
+       if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+        && opnum != OP_UNDEF)
+           CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+       LEAVE;
+       PL_parser = oldparser;
+       PL_curcop = oldcurcop;
+       PL_compcv = oldcompcv;
+    }
+    opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
+    cv_set_call_checker(
+       cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
+    );
+    SvREFCNT_dec(opnumsv);
+    return gv;
+}
+
 /*
 =for apidoc gv_fetchmeth
 
 /*
 =for apidoc gv_fetchmeth
 
+Like L</gv_fetchmeth_pvn>, but lacks a flags parameter.
+
+=for apidoc gv_fetchmeth_sv
+
+Exactly like L</gv_fetchmeth_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+GV *
+Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
+{
+   char *namepv;
+   STRLEN namelen;
+   PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
+   namepv = SvPV(namesv, namelen);
+   if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+   return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
+}
+
+/*
+=for apidoc gv_fetchmeth_pv
+
+Exactly like L</gv_fetchmeth_pvn>, but takes a nul-terminated string 
+instead of a string/length pair.
+
+=cut
+*/
+
+GV *
+Perl_gv_fetchmeth_pv(pTHX_ HV *stash, const char *name, I32 level, U32 flags)
+{
+    PERL_ARGS_ASSERT_GV_FETCHMETH_PV;
+    return gv_fetchmeth_pvn(stash, name, strlen(name), level, flags);
+}
+
+/*
+=for apidoc gv_fetchmeth_pvn
+
 Returns the glob with the given C<name> and a defined subroutine or
 C<NULL>.  The glob lives in the given C<stash>, or in the stashes
 accessible via @ISA and UNIVERSAL::.
 Returns the glob with the given C<name> and a defined subroutine or
 C<NULL>.  The glob lives in the given C<stash>, or in the stashes
 accessible via @ISA and UNIVERSAL::.
@@ -390,7 +617,12 @@ side-effect creates a glob with the given C<name> in the given C<stash>
 which in the case of success contains an alias for the subroutine, and sets
 up caching info for this glob.
 
 which in the case of success contains an alias for the subroutine, and sets
 up caching info for this glob.
 
-This function grants C<"SUPER"> token as a postfix of the stash name. The
+The only significant values for C<flags> are GV_SUPER and SVf_UTF8.
+
+GV_SUPER indicates that we want to look up the method in the superclasses
+of the C<stash>.
+
+The
 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
 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
 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
 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
@@ -402,24 +634,24 @@ obtained from the GV with the C<GvCV> macro.
 /* NOTE: No support for tied ISA */
 
 GV *
 /* NOTE: No support for tied ISA */
 
 GV *
-Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
+Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
 {
     dVAR;
     GV** gvp;
     AV* linear_av;
     SV** linear_svp;
     SV* linear_sv;
 {
     dVAR;
     GV** gvp;
     AV* linear_av;
     SV** linear_svp;
     SV* linear_sv;
-    HV* cstash;
+    HV* cstash, *cachestash;
     GV* candidate = NULL;
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
     I32 create = (level >= 0) ? 1 : 0;
     I32 items;
     GV* candidate = NULL;
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
     I32 create = (level >= 0) ? 1 : 0;
     I32 items;
-    STRLEN packlen;
     U32 topgen_cmp;
     U32 topgen_cmp;
+    U32 is_utf8 = flags & SVf_UTF8;
 
 
-    PERL_ARGS_ASSERT_GV_FETCHMETH;
+    PERL_ARGS_ASSERT_GV_FETCHMETH_PVN;
 
     /* UNIVERSAL methods should be callable without a stash */
     if (!stash) {
 
     /* UNIVERSAL methods should be callable without a stash */
     if (!stash) {
@@ -437,17 +669,26 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     assert(hvname);
     assert(name);
 
     assert(hvname);
     assert(name);
 
-    DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
+    DEBUG_o( Perl_deb(aTHX_ "Looking for %smethod %s in package %s\n",
+                     flags & GV_SUPER ? "SUPER " : "",name,hvname) );
 
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
 
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
+    if (flags & GV_SUPER) {
+       if (!HvAUX(stash)->xhv_super) HvAUX(stash)->xhv_super = newHV();
+       cachestash = HvAUX(stash)->xhv_super;
+    }
+    else cachestash = stash;
+
     /* check locally for a real method or a cache entry */
     /* check locally for a real method or a cache entry */
-    gvp = (GV**)hv_fetch(stash, name, len, create);
+    gvp = (GV**)hv_fetch(cachestash, name, is_utf8 ? -(I32)len : (I32)len,
+                        create);
     if(gvp) {
         topgv = *gvp;
     if(gvp) {
         topgv = *gvp;
+      have_gv:
         assert(topgv);
         if (SvTYPE(topgv) != SVt_PVGV)
         assert(topgv);
         if (SvTYPE(topgv) != SVt_PVGV)
-            gv_init(topgv, stash, name, len, TRUE);
+            gv_init_pvn(topgv, stash, name, len, GV_ADDMULTI|is_utf8);
         if ((cand_cv = GvCV(topgv))) {
             /* If genuine method or valid cache entry, use it */
             if (!GvCVGEN(topgv) || GvCVGEN(topgv) == topgen_cmp) {
         if ((cand_cv = GvCV(topgv))) {
             /* If genuine method or valid cache entry, use it */
             if (!GvCVGEN(topgv) || GvCVGEN(topgv) == topgen_cmp) {
@@ -465,19 +706,14 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
             /* cache indicates no such method definitively */
             return 0;
         }
             /* cache indicates no such method definitively */
             return 0;
         }
+       else if (stash == cachestash
+             && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
+              && strnEQ(hvname, "CORE", 4)
+              && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
+           goto have_gv;
     }
 
     }
 
-    packlen = HvNAMELEN_get(stash);
-    if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
-        HV* basestash;
-        packlen -= 7;
-        basestash = gv_stashpvn(hvname, packlen, GV_ADD);
-        linear_av = mro_get_linear_isa(basestash);
-    }
-    else {
-        linear_av = mro_get_linear_isa(stash); /* has ourselves at the top of the list */
-    }
-
+    linear_av = mro_get_linear_isa(stash); /* has ourselves at the top of the list */
     linear_svp = AvARRAY(linear_av) + 1; /* skip over self */
     items = AvFILLp(linear_av); /* no +1, to skip over self */
     while (items--) {
     linear_svp = AvARRAY(linear_av) + 1; /* skip over self */
     items = AvFILLp(linear_av); /* no +1, to skip over self */
     while (items--) {
@@ -486,18 +722,32 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
         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 @%s::ISA",
-                          SVfARG(linear_sv), hvname);
+           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                           "Can't locate package %"SVf" for @%"HEKf"::ISA",
+                          SVfARG(linear_sv),
+                           HEKfARG(HvNAME_HEK(stash)));
             continue;
         }
 
         assert(cstash);
 
             continue;
         }
 
         assert(cstash);
 
-        gvp = (GV**)hv_fetch(cstash, name, len, 0);
-        if (!gvp) continue;
-        candidate = *gvp;
+        gvp = (GV**)hv_fetch(cstash, name, is_utf8 ? -(I32)len : (I32)len, 0);
+        if (!gvp) {
+            if (len > 1 && HvNAMELEN_get(cstash) == 4) {
+                const char *hvname = HvNAME(cstash); assert(hvname);
+                if (strnEQ(hvname, "CORE", 4)
+                 && (candidate =
+                      S_maybe_add_coresub(aTHX_ cstash,NULL,name,len)
+                    ))
+                    goto have_candidate;
+            }
+            continue;
+        }
+        else candidate = *gvp;
+       have_candidate:
         assert(candidate);
         assert(candidate);
-        if (SvTYPE(candidate) != SVt_PVGV) gv_init(candidate, cstash, name, len, TRUE);
+        if (SvTYPE(candidate) != SVt_PVGV)
+            gv_init_pvn(candidate, cstash, name, len, GV_ADDMULTI|is_utf8);
         if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
             /*
              * Found real method, cache method in topgv if:
         if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
             /*
              * Found real method, cache method in topgv if:
@@ -517,7 +767,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     /* Check UNIVERSAL without caching */
     if(level == 0 || level == -1) {
 
     /* Check UNIVERSAL without caching */
     if(level == 0 || level == -1) {
-        candidate = gv_fetchmeth(NULL, name, len, 1);
+        candidate = gv_fetchmeth_pvn(NULL, name, len, 1, flags &~GV_SUPER);
         if(candidate) {
             cand_cv = GvCV(candidate);
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
         if(candidate) {
             cand_cv = GvCV(candidate);
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
@@ -542,22 +792,66 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 /*
 =for apidoc gv_fetchmeth_autoload
 
 /*
 =for apidoc gv_fetchmeth_autoload
 
-Same as gv_fetchmeth(), but looks for autoloaded subroutines too.
+This is the old form of L</gv_fetchmeth_pvn_autoload>, which has no flags
+parameter.
+
+=for apidoc gv_fetchmeth_sv_autoload
+
+Exactly like L</gv_fetchmeth_pvn_autoload>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+GV *
+Perl_gv_fetchmeth_sv_autoload(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
+{
+   char *namepv;
+   STRLEN namelen;
+   PERL_ARGS_ASSERT_GV_FETCHMETH_SV_AUTOLOAD;
+   namepv = SvPV(namesv, namelen);
+   if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+   return gv_fetchmeth_pvn_autoload(stash, namepv, namelen, level, flags);
+}
+
+/*
+=for apidoc gv_fetchmeth_pv_autoload
+
+Exactly like L</gv_fetchmeth_pvn_autoload>, but takes a nul-terminated string
+instead of a string/length pair.
+
+=cut
+*/
+
+GV *
+Perl_gv_fetchmeth_pv_autoload(pTHX_ HV *stash, const char *name, I32 level, U32 flags)
+{
+    PERL_ARGS_ASSERT_GV_FETCHMETH_PV_AUTOLOAD;
+    return gv_fetchmeth_pvn_autoload(stash, name, strlen(name), level, flags);
+}
+
+/*
+=for apidoc gv_fetchmeth_pvn_autoload
+
+Same as gv_fetchmeth_pvn(), but looks for autoloaded subroutines too.
 Returns a glob for the subroutine.
 
 For an autoloaded subroutine without a GV, will create a GV even
 if C<level < 0>.  For an autoloaded subroutine without a stub, GvCV()
 of the result may be zero.
 
 Returns a glob for the subroutine.
 
 For an autoloaded subroutine without a GV, will create a GV even
 if C<level < 0>.  For an autoloaded subroutine without a stub, GvCV()
 of the result may be zero.
 
+Currently, the only significant value for C<flags> is SVf_UTF8.
+
 =cut
 */
 
 GV *
 =cut
 */
 
 GV *
-Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
+Perl_gv_fetchmeth_pvn_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
 {
 {
-    GV *gv = gv_fetchmeth(stash, name, len, level);
+    GV *gv = gv_fetchmeth_pvn(stash, name, len, level, flags);
 
 
-    PERL_ARGS_ASSERT_GV_FETCHMETH_AUTOLOAD;
+    PERL_ARGS_ASSERT_GV_FETCHMETH_PVN_AUTOLOAD;
 
     if (!gv) {
        CV *cv;
 
     if (!gv) {
        CV *cv;
@@ -567,15 +861,16 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le
            return NULL;        /* UNIVERSAL::AUTOLOAD could cause trouble */
        if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
            return NULL;
            return NULL;        /* UNIVERSAL::AUTOLOAD could cause trouble */
        if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
            return NULL;
-       if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
+       if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, flags)))
            return NULL;
        cv = GvCV(gv);
        if (!(CvROOT(cv) || CvXSUB(cv)))
            return NULL;
        /* Have an autoload */
        if (level < 0)  /* Cannot do without a stub */
            return NULL;
        cv = GvCV(gv);
        if (!(CvROOT(cv) || CvXSUB(cv)))
            return NULL;
        /* Have an autoload */
        if (level < 0)  /* Cannot do without a stub */
-           gv_fetchmeth(stash, name, len, 0);
-       gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
+           gv_fetchmeth_pvn(stash, name, len, 0, flags);
+       gvp = (GV**)hv_fetch(stash, name,
+                        (flags & SVf_UTF8) ? -(I32)len : (I32)len, (level >= 0));
        if (!gvp)
            return NULL;
        return *gvp;
        if (!gvp)
            return NULL;
        return *gvp;
@@ -611,54 +906,40 @@ C<call_sv> apply equally to these functions.
 =cut
 */
 
 =cut
 */
 
-STATIC HV*
-S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
+GV *
+Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
 {
-    AV* superisa;
-    GV** gvp;
-    GV* gv;
-    HV* stash;
-
-    PERL_ARGS_ASSERT_GV_GET_SUPER_PKG;
-
-    stash = gv_stashpvn(name, namelen, 0);
-    if(stash) return stash;
-
-    /* If we must create it, give it an @ISA array containing
-       the real package this SUPER is for, so that it's tied
-       into the cache invalidation code correctly */
-    stash = gv_stashpvn(name, namelen, GV_ADD);
-    gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
-    gv = *gvp;
-    gv_init(gv, stash, "ISA", 3, TRUE);
-    superisa = GvAVn(gv);
-    GvMULTI_on(gv);
-    sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
-#ifdef USE_ITHREADS
-    av_push(superisa, newSVpv(CopSTASHPV(PL_curcop), 0));
-#else
-    av_push(superisa, newSVhek(CopSTASH(PL_curcop)
-                              ? HvNAME_HEK(CopSTASH(PL_curcop)) : NULL));
-#endif
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
 
 
-    return stash;
+    return gv_fetchmethod_flags(stash, name, autoload ? GV_AUTOLOAD : 0);
 }
 
 GV *
 }
 
 GV *
-Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
+Perl_gv_fetchmethod_sv_flags(pTHX_ HV *stash, SV *namesv, U32 flags)
 {
 {
-    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
+    char *namepv;
+    STRLEN namelen;
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_SV_FLAGS;
+    namepv = SvPV(namesv, namelen);
+    if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+    return gv_fetchmethod_pvn_flags(stash, namepv, namelen, flags);
+}
 
 
-    return gv_fetchmethod_flags(stash, name, autoload ? GV_AUTOLOAD : 0);
+GV *
+Perl_gv_fetchmethod_pv_flags(pTHX_ HV *stash, const char *name, U32 flags)
+{
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_PV_FLAGS;
+    return gv_fetchmethod_pvn_flags(stash, name, strlen(name), flags);
 }
 
 /* Don't merge this yet, as it's likely to get a len parameter, and possibly
    even a U32 hash */
 GV *
 }
 
 /* Don't merge this yet, as it's likely to get a len parameter, and possibly
    even a U32 hash */
 GV *
-Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
+Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
 {
     dVAR;
 {
     dVAR;
-    register const char *nend;
+    const char *nend;
     const char *nsplit = NULL;
     GV* gv;
     HV* ostash = stash;
     const char *nsplit = NULL;
     GV* gv;
     HV* ostash = stash;
@@ -666,8 +947,9 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
     SV *const error_report = MUTABLE_SV(stash);
     const U32 autoload = flags & GV_AUTOLOAD;
     const U32 do_croak = flags & GV_CROAK;
     SV *const error_report = MUTABLE_SV(stash);
     const U32 autoload = flags & GV_AUTOLOAD;
     const U32 do_croak = flags & GV_CROAK;
+    const U32 is_utf8  = flags & SVf_UTF8;
 
 
-    PERL_ARGS_ASSERT_GV_FETCHMETHOD_FLAGS;
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_PVN_FLAGS;
 
     if (SvTYPE(stash) < SVt_PVHV)
        stash = NULL;
 
     if (SvTYPE(stash) < SVt_PVHV)
        stash = NULL;
@@ -677,7 +959,7 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
           the error reporting code.  */
     }
 
           the error reporting code.  */
     }
 
-    for (nend = name; *nend; nend++) {
+    for (nend = name; *nend || nend != (origname + len); nend++) {
        if (*nend == '\'') {
            nsplit = nend;
            name = nend + 1;
        if (*nend == '\'') {
            nsplit = nend;
            name = nend + 1;
@@ -690,33 +972,32 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
-           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
-                                                 CopSTASHPV(PL_curcop)));
-           /* __PACKAGE__::SUPER stash should be autovivified */
-           stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr));
+           stash = CopSTASH(PL_curcop);
+           flags |= GV_SUPER;
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
-                        origname, HvNAME_get(stash), name) );
+                        origname, HvENAME_get(stash), name) );
+       }
+       else if ((nsplit - origname) >= 7 &&
+                strnEQ(nsplit - 7, "::SUPER", 7)) {
+            /* don't autovifify if ->NoSuchStash::SUPER::method */
+           stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
+           if (stash) flags |= GV_SUPER;
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
-            stash = gv_stashpvn(origname, nsplit - origname, 0);
-
-           /* however, explicit calls to Pkg::SUPER::method may
-              happen, and may require autovivification to work */
-           if (!stash && (nsplit - origname) >= 7 &&
-               strnEQ(nsplit - 7, "::SUPER", 7) &&
-               gv_stashpvn(origname, nsplit - origname - 7, 0))
-             stash = gv_get_super_pkg(origname, nsplit - origname);
+            stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
        }
        ostash = stash;
     }
 
        }
        ostash = stash;
     }
 
-    gv = gv_fetchmeth(stash, name, nend - name, 0);
+    gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
     if (!gv) {
        if (strEQ(name,"import") || strEQ(name,"unimport"))
            gv = MUTABLE_GV(&PL_sv_yes);
        else if (autoload)
     if (!gv) {
        if (strEQ(name,"import") || strEQ(name,"unimport"))
            gv = MUTABLE_GV(&PL_sv_yes);
        else if (autoload)
-           gv = gv_autoload4(ostash, name, nend - name, TRUE);
+           gv = gv_autoload_pvn(
+               ostash, name, nend - name, GV_AUTOLOAD_ISMETHOD|flags
+           );
        if (!gv && do_croak) {
            /* Right now this is exclusively for the benefit of S_method_common
               in pp_hot.c  */
        if (!gv && do_croak) {
            /* Right now this is exclusively for the benefit of S_method_common
               in pp_hot.c  */
@@ -731,29 +1012,33 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
                                       HV_FETCH_ISEXISTS, NULL, 0)
                ) {
                    require_pv("IO/File.pm");
                                       HV_FETCH_ISEXISTS, NULL, 0)
                ) {
                    require_pv("IO/File.pm");
-                   gv = gv_fetchmeth(stash, name, nend - name, 0);
+                   gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
                    if (gv)
                        return gv;
                }
                Perl_croak(aTHX_
                    if (gv)
                        return gv;
                }
                Perl_croak(aTHX_
-                          "Can't locate object method \"%s\" via package \"%.*s\"",
-                          name, (int)HvNAMELEN_get(stash), HvNAME_get(stash));
+                          "Can't locate object method \"%"SVf
+                          "\" via package \"%"HEKf"\"",
+                                   SVfARG(newSVpvn_flags(name, nend - name,
+                                           SVs_TEMP | is_utf8)),
+                                    HEKfARG(HvNAME_HEK(stash)));
            }
            else {
            }
            else {
-               STRLEN packlen;
-               const char *packname;
+                SV* packnamesv;
 
                if (nsplit) {
 
                if (nsplit) {
-                   packlen = nsplit - origname;
-                   packname = origname;
+                   packnamesv = newSVpvn_flags(origname, nsplit - origname,
+                                                    SVs_TEMP | is_utf8);
                } else {
                } else {
-                   packname = SvPV_const(error_report, packlen);
+                   packnamesv = sv_2mortal(newSVsv(error_report));
                }
 
                Perl_croak(aTHX_
                }
 
                Perl_croak(aTHX_
-                          "Can't locate object method \"%s\" via package \"%.*s\""
-                          " (perhaps you forgot to load \"%.*s\"?)",
-                          name, (int)packlen, packname, (int)packlen, packname);
+                          "Can't locate object method \"%"SVf"\" via package \"%"SVf"\""
+                          " (perhaps you forgot to load \"%"SVf"\"?)",
+                          SVfARG(newSVpvn_flags(name, nend - name,
+                                SVs_TEMP | is_utf8)),
+                           SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
     }
            }
        }
     }
@@ -770,8 +1055,10 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
                if (GvCV(stubgv) != cv)         /* orphaned import */
                    stubgv = gv;
            }
                if (GvCV(stubgv) != cv)         /* orphaned import */
                    stubgv = gv;
            }
-           autogv = gv_autoload4(GvSTASH(stubgv),
-                                 GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
+            autogv = gv_autoload_pvn(GvSTASH(stubgv),
+                                  GvNAME(stubgv), GvNAMELEN(stubgv),
+                                  GV_AUTOLOAD_ISMETHOD
+                                   | (GvNAMEUTF8(stubgv) ? SVf_UTF8 : 0));
            if (autogv)
                gv = autogv;
        }
            if (autogv)
                gv = autogv;
        }
@@ -781,7 +1068,26 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
 }
 
 GV*
 }
 
 GV*
-Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
+Perl_gv_autoload_sv(pTHX_ HV *stash, SV* namesv, U32 flags)
+{
+   char *namepv;
+   STRLEN namelen;
+   PERL_ARGS_ASSERT_GV_AUTOLOAD_SV;
+   namepv = SvPV(namesv, namelen);
+   if (SvUTF8(namesv))
+       flags |= SVf_UTF8;
+   return gv_autoload_pvn(stash, namepv, namelen, flags);
+}
+
+GV*
+Perl_gv_autoload_pv(pTHX_ HV *stash, const char *namepv, U32 flags)
+{
+   PERL_ARGS_ASSERT_GV_AUTOLOAD_PV;
+   return gv_autoload_pvn(stash, namepv, strlen(namepv), flags);
+}
+
+GV*
+Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
 {
     dVAR;
     GV* gv;
 {
     dVAR;
     GV* gv;
@@ -789,24 +1095,26 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     HV* varstash;
     GV* vargv;
     SV* varsv;
     HV* varstash;
     GV* vargv;
     SV* varsv;
-    const char *packname = "";
-    STRLEN packname_len = 0;
+    SV *packname = NULL;
+    U32 is_utf8 = flags & SVf_UTF8 ? SVf_UTF8 : 0;
 
 
-    PERL_ARGS_ASSERT_GV_AUTOLOAD4;
+    PERL_ARGS_ASSERT_GV_AUTOLOAD_PVN;
 
     if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
        return NULL;
     if (stash) {
        if (SvTYPE(stash) < SVt_PVHV) {
 
     if (len == S_autolen && memEQ(name, S_autoload, S_autolen))
        return NULL;
     if (stash) {
        if (SvTYPE(stash) < SVt_PVHV) {
-           packname = SvPV_const(MUTABLE_SV(stash), packname_len);
+            STRLEN packname_len = 0;
+            const char * const packname_ptr = SvPV_const(MUTABLE_SV(stash), packname_len);
+            packname = newSVpvn_flags(packname_ptr, packname_len,
+                                      SVs_TEMP | SvUTF8(stash));
            stash = NULL;
        }
            stash = NULL;
        }
-       else {
-           packname = HvNAME_get(stash);
-           packname_len = HvNAMELEN_get(stash);
-       }
+       else
+           packname = sv_2mortal(newSVhek(HvNAME_HEK(stash)));
+       if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER");
     }
     }
-    if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
+    if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, is_utf8)))
        return NULL;
     cv = GvCV(gv);
 
        return NULL;
     cv = GvCV(gv);
 
@@ -816,22 +1124,66 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     /*
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
     /*
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
-    if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash)
+    if (
+        !(flags & GV_AUTOLOAD_ISMETHOD)
+     && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
     )
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
-                        packname, (int)len, name);
+                        "Use of inherited AUTOLOAD for non-method %"SVf"::%"SVf"() is deprecated",
+                        SVfARG(packname),
+                         SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8)));
 
     if (CvISXSUB(cv)) {
 
     if (CvISXSUB(cv)) {
-        /* rather than lookup/init $AUTOLOAD here
-         * only to have the XSUB do another lookup for $AUTOLOAD
-         * and split that value on the last '::',
-         * pass along the same data via some unused fields in the CV
+        /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
+         * and split that value on the last '::', pass along the same data
+         * via the SvPVX field in the CV, and the stash in CvSTASH.
+         *
+         * Due to an unfortunate accident of history, the SvPVX field
+         * serves two purposes.  It is also used for the subroutine's pro-
+         * type.  Since SvPVX has been documented as returning the sub name
+         * for a long time, but not as returning the prototype, we have
+         * to preserve the SvPVX AUTOLOAD behaviour and put the prototype
+         * elsewhere.
+         *
+         * We put the prototype in the same allocated buffer, but after
+         * the sub name.  The SvPOK flag indicates the presence of a proto-
+         * type.  The CvAUTOLOAD flag indicates the presence of a sub name.
+         * If both flags are on, then SvLEN is used to indicate the end of
+         * the prototype (artificially lower than what is actually allo-
+         * cated), at the risk of having to reallocate a few bytes unneces-
+         * sarily--but that should happen very rarely, if ever.
+         *
+         * We use SvUTF8 for both prototypes and sub names, so if one is
+         * UTF8, the other must be upgraded.
          */
        CvSTASH_set(cv, stash);
          */
        CvSTASH_set(cv, stash);
-        SvPV_set(cv, (char *)name); /* cast to lose constness warning */
-        SvCUR_set(cv, len);
-        return gv;
+       if (SvPOK(cv)) { /* Ouch! */
+           SV *tmpsv = newSVpvn_flags(name, len, is_utf8);
+           STRLEN ulen;
+           const char *proto = CvPROTO(cv);
+           assert(proto);
+           if (SvUTF8(cv))
+               sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2);
+           ulen = SvCUR(tmpsv);
+           SvCUR(tmpsv)++; /* include null in string */
+           sv_catpvn_flags(
+               tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv)
+           );
+           SvTEMP_on(tmpsv); /* Allow theft */
+           sv_setsv_nomg((SV *)cv, tmpsv);
+           SvTEMP_off(tmpsv);
+           SvREFCNT_dec(tmpsv);
+           SvLEN(cv) = SvCUR(cv) + 1;
+           SvCUR(cv) = ulen;
+       }
+       else {
+         sv_setpvn((SV *)cv, name, len);
+         SvPOK_off(cv);
+         if (is_utf8)
+            SvUTF8_on(cv);
+         else SvUTF8_off(cv);
+       }
+       CvAUTOLOAD_on(cv);
     }
 
     /*
     }
 
     /*
@@ -845,18 +1197,25 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     ENTER;
 
     if (!isGV(vargv)) {
     ENTER;
 
     if (!isGV(vargv)) {
-       gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
+       gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0);
 #ifdef PERL_DONT_CREATE_GVSV
        GvSV(vargv) = newSV(0);
 #endif
     }
     LEAVE;
     varsv = GvSVn(vargv);
 #ifdef PERL_DONT_CREATE_GVSV
        GvSV(vargv) = newSV(0);
 #endif
     }
     LEAVE;
     varsv = GvSVn(vargv);
-    sv_setpvn(varsv, packname, packname_len);
+    SvTAINTED_off(varsv); /* previous $AUTOLOAD taint is obsolete */
+    /* XXX: this process is not careful to avoid extra magic gets and sets; tied $AUTOLOAD will get noise */
+    sv_setsv(varsv, packname);
     sv_catpvs(varsv, "::");
     /* Ensure SvSETMAGIC() is called if necessary. In particular, to clear
        tainting if $FOO::AUTOLOAD was previously tainted, but is not now.  */
     sv_catpvs(varsv, "::");
     /* Ensure SvSETMAGIC() is called if necessary. In particular, to clear
        tainting if $FOO::AUTOLOAD was previously tainted, but is not now.  */
-    sv_catpvn_mg(varsv, name, len);
+    sv_catpvn_flags(
+       varsv, name, len,
+       SV_SMAGIC|(is_utf8 ? SV_CATUTF8 : SV_CATBYTES)
+    );
+    if (is_utf8)
+        SvUTF8_on(varsv);
     return gv;
 }
 
     return gv;
 }
 
@@ -881,29 +1240,30 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
-    if (!stash || !(gv_fetchmethod(stash, methpv))) {
+    if (!stash || !(gv_fetchmethod_autoload(stash, methpv, FALSE))) {
        SV *module = newSVsv(namesv);
        char varname = *varpv; /* varpv might be clobbered by load_module,
                                  so save it. For the moment it's always
                                  a single char. */
        SV *module = newSVsv(namesv);
        char varname = *varpv; /* varpv might be clobbered by load_module,
                                  so save it. For the moment it's always
                                  a single char. */
+       const char type = varname == '[' ? '$' : '%';
        dSP;
        ENTER;
        dSP;
        ENTER;
+       SAVEFREESV(namesv);
        if ( flags & 1 )
            save_scalar(gv);
        PUSHSTACKi(PERLSI_MAGIC);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        POPSTACK;
        if ( flags & 1 )
            save_scalar(gv);
        PUSHSTACKi(PERLSI_MAGIC);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        POPSTACK;
-       LEAVE;
-       SPAGAIN;
        stash = gv_stashsv(namesv, 0);
        if (!stash)
        stash = gv_stashsv(namesv, 0);
        if (!stash)
-           Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" is not available",
-                   varname, SVfARG(namesv));
+           Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available",
+                   type, varname, SVfARG(namesv));
        else if (!gv_fetchmethod(stash, methpv))
        else if (!gv_fetchmethod(stash, methpv))
-           Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" does not support method %s",
-                   varname, SVfARG(namesv), methpv);
+           Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s",
+                   type, varname, SVfARG(namesv), methpv);
+       LEAVE;
     }
     }
-    SvREFCNT_dec(namesv);
+    else SvREFCNT_dec(namesv);
     return stash;
 }
 
     return stash;
 }
 
@@ -933,6 +1293,16 @@ created if it does not already exist.  If the package does not exist and
 C<flags> is 0 (or any other setting that does not create packages) then NULL
 is returned.
 
 C<flags> is 0 (or any other setting that does not create packages) then NULL
 is returned.
 
+Flags may be one of:
+
+    GV_ADD
+    SVf_UTF8
+    GV_NOADD_NOINIT
+    GV_NOINIT
+    GV_NOEXPAND
+    GV_ADDMG
+
+The most important of which are probably GV_ADD and SVf_UTF8.
 
 =cut
 */
 
 =cut
 */
@@ -964,7 +1334,7 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
     if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL;
     assert(stash);
     if (!HvNAME_get(stash)) {
     if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL;
     assert(stash);
     if (!HvNAME_get(stash)) {
-       hv_name_set(stash, name, namelen, 0);
+       hv_name_set(stash, name, namelen, flags & SVf_UTF8 ? SVf_UTF8 : 0 );
        
        /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */
        /* If the containing stash has multiple effective
        
        /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */
        /* If the containing stash has multiple effective
@@ -991,7 +1361,7 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
 
     PERL_ARGS_ASSERT_GV_STASHSV;
 
 
     PERL_ARGS_ASSERT_GV_STASHSV;
 
-    return gv_stashpvn(ptr, len, flags);
+    return gv_stashpvn(ptr, len, flags | SvUTF8(sv));
 }
 
 
 }
 
 
@@ -1004,7 +1374,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, const svtype sv_type) {
 GV *
 Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, const svtype sv_type) {
     STRLEN len;
 GV *
 Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, const svtype sv_type) {
     STRLEN len;
-    const char * const nambeg = SvPV_const(name, len);
+    const char * const nambeg =
+       SvPV_flags_const(name, len, flags & GV_NO_SVGMAGIC ? 0 : SV_GMAGIC);
     PERL_ARGS_ASSERT_GV_FETCHSV;
     return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
 }
     PERL_ARGS_ASSERT_GV_FETCHSV;
     return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
 }
@@ -1022,34 +1393,22 @@ S_gv_magicalize_isa(pTHX_ GV *gv)
             NULL, 0);
 }
 
             NULL, 0);
 }
 
-STATIC void
-S_gv_magicalize_overload(pTHX_ GV *gv)
-{
-    HV* hv;
-
-    PERL_ARGS_ASSERT_GV_MAGICALIZE_OVERLOAD;
-
-    hv = GvHVn(gv);
-    GvMULTI_on(gv);
-    hv_magic(hv, NULL, PERL_MAGIC_overload);
-}
-
-static void core_xsub(pTHX_ CV* cv);
-
 GV *
 Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                       const svtype sv_type)
 {
     dVAR;
 GV *
 Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                       const svtype sv_type)
 {
     dVAR;
-    register const char *name = nambeg;
-    register GV *gv = NULL;
+    const char *name = nambeg;
+    GV *gv = NULL;
     GV**gvp;
     I32 len;
     GV**gvp;
     I32 len;
-    register const char *name_cursor;
+    const char *name_cursor;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const I32 no_expand = flags & GV_NOEXPAND;
     const I32 add = flags & ~GV_NOADD_MASK;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const I32 no_expand = flags & GV_NOEXPAND;
     const I32 add = flags & ~GV_NOADD_MASK;
+    const U32 is_utf8 = flags & SVf_UTF8;
+    bool addmg = !!(flags & GV_ADDMG);
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
     U32 faking_it;
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
     U32 faking_it;
@@ -1062,7 +1421,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        goto no_stash;
     }
 
        goto no_stash;
     }
 
-    if (full_len > 2 && *name == '*' && isALPHA(name[1])) {
+    if (full_len > 2 && *name == '*' && isIDFIRST_lazy_if(name + 1, is_utf8)) {
        /* accidental stringify on a GV? */
        name++;
     }
        /* accidental stringify on a GV? */
        name++;
     }
@@ -1092,11 +1451,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    tmpbuf[len++] = ':';
                    key = tmpbuf;
                }
                    tmpbuf[len++] = ':';
                    key = tmpbuf;
                }
-               gvp = (GV**)hv_fetch(stash, key, len, add);
+               gvp = (GV**)hv_fetch(stash, key, is_utf8 ? -len : len, add);
                gv = gvp ? *gvp : NULL;
                if (gv && gv != (const GV *)&PL_sv_undef) {
                    if (SvTYPE(gv) != SVt_PVGV)
                gv = gvp ? *gvp : NULL;
                if (gv && gv != (const GV *)&PL_sv_undef) {
                    if (SvTYPE(gv) != SVt_PVGV)
-                       gv_init(gv, stash, key, len, (add & GV_ADDMULTI));
+                       gv_init_pvn(gv, stash, key, len, (add & GV_ADDMULTI)|is_utf8);
                    else
                        GvMULTI_on(gv);
                }
                    else
                        GvMULTI_on(gv);
                }
@@ -1114,7 +1473,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                            hv_name_set(stash, "CORE", 4, 0);
                        else
                            hv_name_set(
                            hv_name_set(stash, "CORE", 4, 0);
                        else
                            hv_name_set(
-                               stash, nambeg, name_cursor-nambeg, 0
+                               stash, nambeg, name_cursor-nambeg, is_utf8
                            );
                        /* If the containing stash has multiple effective
                           names, see that this one gets them, too. */
                            );
                        /* If the containing stash has multiple effective
                           names, see that this one gets them, too. */
@@ -1123,7 +1482,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    }
                }
                else if (!HvNAME_get(stash))
                    }
                }
                else if (!HvNAME_get(stash))
-                   hv_name_set(stash, nambeg, name_cursor - nambeg, 0);
+                   hv_name_set(stash, nambeg, name_cursor - nambeg, is_utf8);
            }
 
            if (*name_cursor == ':')
            }
 
            if (*name_cursor == ':')
@@ -1190,7 +1549,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    !(len == 1 && sv_type == SVt_PV &&
                      (*name == 'a' || *name == 'b')) )
                {
                    !(len == 1 && sv_type == SVt_PV &&
                      (*name == 'a' || *name == 'b')) )
                {
-                   gvp = (GV**)hv_fetch(stash,name,len,0);
+                   gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -len : len,0);
                    if (!gvp ||
                        *gvp == (const GV *)&PL_sv_undef ||
                        SvTYPE(*gvp) != SVt_PVGV)
                    if (!gvp ||
                        *gvp == (const GV *)&PL_sv_undef ||
                        SvTYPE(*gvp) != SVt_PVGV)
@@ -1201,17 +1560,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                             (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
                             (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
                    {
                             (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
                             (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
                    {
+                        SV* namesv = newSVpvn_flags(name, len, SVs_TEMP | is_utf8);
                        /* diag_listed_as: Variable "%s" is not imported%s */
                        Perl_ck_warner_d(
                            aTHX_ packWARN(WARN_MISC),
                        /* diag_listed_as: Variable "%s" is not imported%s */
                        Perl_ck_warner_d(
                            aTHX_ packWARN(WARN_MISC),
-                           "Variable \"%c%s\" is not imported",
+                           "Variable \"%c%"SVf"\" is not imported",
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
-                           name);
+                           SVfARG(namesv));
                        if (GvCVu(*gvp))
                            Perl_ck_warner_d(
                                aTHX_ packWARN(WARN_MISC),
                        if (GvCVu(*gvp))
                            Perl_ck_warner_d(
                                aTHX_ packWARN(WARN_MISC),
-                               "\t(Did you mean &%s instead?)\n", name
+                               "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv)
                            );
                        stash = NULL;
                    }
                            );
                        stash = NULL;
                    }
@@ -1229,11 +1589,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if (!stash) {
        if (add) {
            SV * const err = Perl_mess(aTHX_
     if (!stash) {
        if (add) {
            SV * const err = Perl_mess(aTHX_
-                "Global symbol \"%s%s\" requires explicit package name",
+                "Global symbol \"%s%"SVf"\" requires explicit package name",
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
-                 : ""), name);
+                 : ""), SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8)));
            GV *gv;
            if (USE_UTF8_IN_NAMES)
                SvUTF8_on(err);
            GV *gv;
            if (USE_UTF8_IN_NAMES)
                SvUTF8_on(err);
@@ -1252,20 +1612,45 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if (!SvREFCNT(stash))      /* symbol table under destruction */
        return NULL;
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */
        return NULL;
 
-    gvp = (GV**)hv_fetch(stash,name,len,add);
-    if (!gvp || *gvp == (const GV *)&PL_sv_undef)
-       return NULL;
-    gv = *gvp;
+    gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -len : len,add);
+    if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
+       if (addmg) gv = (GV *)newSV(0);
+       else return NULL;
+    }
+    else gv = *gvp, addmg = 0;
+    /* From this point on, addmg means gv has not been inserted in the
+       symtab yet. */
+
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
            GvMULTI_on(gv);
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
            GvMULTI_on(gv);
-           gv_init_sv(gv, sv_type);
-           if (len == 1 && stash == PL_defstash
-               && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
+           gv_init_svtype(gv, sv_type);
+           if (len == 1 && stash == PL_defstash) {
+             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
+             }
+             if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
+                switch (*name) {
+               case '[':
+                   require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+                    break;
+               case '`':
+                   PL_sawampersand |= SAWAMPERSAND_LEFT;
+                    (void)GvSVn(gv);
+                    break;
+               case '&':
+                   PL_sawampersand |= SAWAMPERSAND_MIDDLE;
+                    (void)GvSVn(gv);
+                    break;
+               case '\'':
+                   PL_sawampersand |= SAWAMPERSAND_RIGHT;
+                    (void)GvSVn(gv);
+                    break;
+                }
+             }
            }
            else if (len == 3 && sv_type == SVt_PVAV
                  && strnEQ(name, "ISA", 3)
            }
            else if (len == 3 && sv_type == SVt_PVAV
                  && strnEQ(name, "ISA", 3)
@@ -1274,8 +1659,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        }
        return gv;
     } else if (no_init) {
        }
        return gv;
     } else if (no_init) {
+       assert(!addmg);
        return gv;
     } else if (no_expand && SvROK(gv)) {
        return gv;
     } else if (no_expand && SvROK(gv)) {
+       assert(!addmg);
        return gv;
     }
 
        return gv;
     }
 
@@ -1289,17 +1676,17 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     faking_it = SvOK(gv);
 
     if (add & GV_ADDWARN)
     faking_it = SvOK(gv);
 
     if (add & GV_ADDWARN)
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
-    gv_init(gv, stash, name, len, add & GV_ADDMULTI);
-    gv_init_sv(gv, faking_it ? SVt_PVCV : sv_type);
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %"SVf" unexpectedly",
+                SVfARG(newSVpvn_flags(nambeg, name_end-nambeg, SVs_TEMP | is_utf8 )));
+    gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
 
-    if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
-                                           : (PL_dowarn & G_WARN_ON ) ) )
+    if ( isIDFIRST_lazy_if(name, is_utf8)
+                && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) : (PL_dowarn & G_WARN_ON ) ) )
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */
     if (stash != PL_defstash) { /* not the main stash */
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */
     if (stash != PL_defstash) { /* not the main stash */
-       /* We only have to check for four names here: EXPORT, ISA, OVERLOAD
+       /* We only have to check for three names here: EXPORT, ISA
           and VERSION. All the others apply only to the main stash or to
           CORE (which is checked right after this). */
        if (len > 2) {
           and VERSION. All the others apply only to the main stash or to
           CORE (which is checked right after this). */
        if (len > 2) {
@@ -1313,10 +1700,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (strEQ(name2, "SA"))
                    gv_magicalize_isa(gv);
                break;
                if (strEQ(name2, "SA"))
                    gv_magicalize_isa(gv);
                break;
-           case 'O':
-               if (strEQ(name2, "VERLOAD"))
-                   gv_magicalize_overload(gv);
-               break;
            case 'V':
                if (strEQ(name2, "ERSION"))
                    GvMULTI_on(gv);
            case 'V':
                if (strEQ(name2, "ERSION"))
                    GvMULTI_on(gv);
@@ -1324,108 +1707,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            default:
                goto try_core;
            }
            default:
                goto try_core;
            }
-           return gv;
+           goto add_magical_gv;
        }
       try_core:
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
          /* Avoid null warning: */
          const char * const stashname = HvNAME(stash); assert(stashname);
        }
       try_core:
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
          /* Avoid null warning: */
          const char * const stashname = HvNAME(stash); assert(stashname);
-         if (strnEQ(stashname, "CORE", 4)) {
-           const int code = keyword(name, len, 1);
-           static const char file[] = __FILE__;
-           CV *cv, *oldcompcv;
-           int opnum = 0;
-           SV *opnumsv;
-           bool ampable = TRUE; /* &{}-able */
-           COP *oldcurcop;
-           yy_parser *oldparser;
-           I32 oldsavestack_ix;
-
-           if (code >= 0) return gv; /* not overridable */
-           switch (-code) {
-            /* no support for \&CORE::infix;
-               no support for funcs that take labels, as their parsing is
-               weird  */
-           case KEY_and: case KEY_cmp: case KEY_CORE: case KEY_dump:
-           case KEY_eq: case KEY_ge:
-           case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne:
-           case KEY_or: case KEY_x: case KEY_xor:
-               return gv;
-           case KEY_chdir:
-           case KEY_chomp: case KEY_chop:
-           case KEY_each: case KEY_eof: case KEY_exec:
-           case KEY_keys:
-           case KEY_lstat:
-           case KEY_pop:
-           case KEY_push:
-           case KEY_shift:
-           case KEY_splice:
-           case KEY_stat:
-           case KEY_system:
-           case KEY_truncate: case KEY_unlink:
-           case KEY_unshift:
-           case KEY_values: case KEY_write:
-               ampable = FALSE;
-           }
-           if (ampable) {
-               ENTER;
-               oldcurcop = PL_curcop;
-               oldparser = PL_parser;
-               lex_start(NULL, NULL, 0);
-               oldcompcv = PL_compcv;
-               PL_compcv = NULL; /* Prevent start_subparse from setting
-                                    CvOUTSIDE. */
-               oldsavestack_ix = start_subparse(FALSE,0);
-               cv = PL_compcv;
-           }
-           else {
-               /* Avoid calling newXS, as it calls us, and things start to
-                  get hairy. */
-               cv = MUTABLE_CV(newSV_type(SVt_PVCV));
-               GvCV_set(gv,cv);
-               GvCVGEN(gv) = 0;
-               mro_method_changed_in(GvSTASH(gv));
-               CvISXSUB_on(cv);
-               CvXSUB(cv) = core_xsub;
-           }
-           CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
-                                from PL_curcop. */
-           (void)gv_fetchfile(file);
-           CvFILE(cv) = (char *)file;
-           /* XXX This is inefficient, as doing things this order causes
-                  a prototype check in newATTRSUB.  But we have to do
-                  it this order as we need an op number before calling
-                  new ATTRSUB. */
-           (void)core_prototype((SV *)cv, name, code, &opnum);
-           if (ampable) {
-               CvLVALUE_on(cv);
-               newATTRSUB(oldsavestack_ix,
-                          newSVOP(
-                                OP_CONST, 0,
-                                newSVpvn_share(nambeg,full_len,0)
-                          ),
-                          NULL,NULL,
-                          coresub_op(
-                            opnum
-                              ? newSVuv((UV)opnum)
-                              : newSVpvn(name,len),
-                            code, opnum
-                          )
-               );
-               assert(GvCV(gv) == cv);
-               if (opnum != OP_VEC && opnum != OP_SUBSTR)
-                   CvLVALUE_off(cv); /* Now *that* was a neat trick. */
-               LEAVE;
-               PL_parser = oldparser;
-               PL_curcop = oldcurcop;
-               PL_compcv = oldcompcv;
-           }
-           opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
-           cv_set_call_checker(
-              cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
-           );
-           SvREFCNT_dec(opnumsv);
-         }
+         if (strnEQ(stashname, "CORE", 4))
+           S_maybe_add_coresub(aTHX_ 0, gv, name, len);
        }
     }
     else if (len > 1) {
        }
     }
     else if (len > 1) {
@@ -1458,11 +1747,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    gv_magicalize_isa(gv);
                }
                break;
                    gv_magicalize_isa(gv);
                }
                break;
-           case 'O':
-               if (strEQ(name2, "VERLOAD")) {
-                   gv_magicalize_overload(gv);
-               }
-               break;
            case 'S':
                if (strEQ(name2, "IG")) {
                    HV *hv;
            case 'S':
                if (strEQ(name2, "IG")) {
                    HV *hv;
@@ -1510,6 +1794,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (strEQ(name2, "LOBAL_PHASE"))
                    goto ro_magicalize;
                break;
                if (strEQ(name2, "LOBAL_PHASE"))
                    goto ro_magicalize;
                break;
+           case '\014':        /* $^LAST_FH */
+               if (strEQ(name2, "AST_FH"))
+                   goto ro_magicalize;
+               break;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
@@ -1552,7 +1840,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                /* This snippet is taken from is_gv_magical */
                const char *end = name + len;
                while (--end > name) {
                /* This snippet is taken from is_gv_magical */
                const char *end = name + len;
                while (--end > name) {
-                   if (!isDIGIT(*end)) return gv;
+                   if (!isDIGIT(*end)) goto add_magical_gv;
                }
                goto magicalize;
            }
                }
                goto magicalize;
            }
@@ -1565,14 +1853,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '&':               /* $& */
        case '`':               /* $` */
        case '\'':              /* $' */
        case '&':               /* $& */
        case '`':               /* $` */
        case '\'':              /* $' */
-           if (
+           if (!(
                sv_type == SVt_PVAV ||
                sv_type == SVt_PVHV ||
                sv_type == SVt_PVCV ||
                sv_type == SVt_PVFM ||
                sv_type == SVt_PVIO
                sv_type == SVt_PVAV ||
                sv_type == SVt_PVHV ||
                sv_type == SVt_PVCV ||
                sv_type == SVt_PVFM ||
                sv_type == SVt_PVIO
-               ) { break; }
-           PL_sawampersand = TRUE;
+               )) { PL_sawampersand |=
+                        (*name == '`')
+                            ? SAWAMPERSAND_LEFT
+                            : (*name == '&')
+                                ? SAWAMPERSAND_MIDDLE
+                                : SAWAMPERSAND_RIGHT;
+                }
            goto magicalize;
 
        case ':':               /* $: */
            goto magicalize;
 
        case ':':               /* $: */
@@ -1593,7 +1886,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
             /* magicalization must be done before require_tie_mod is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
 
             /* magicalization must be done before require_tie_mod is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
+           {
+               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
+               addmg = 0;
                require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
+           }
 
            break;
        case '-':               /* $- */
 
            break;
        case '-':               /* $- */
@@ -1610,26 +1907,36 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             SvREADONLY_on(av);
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
             SvREADONLY_on(av);
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
+           {
+               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
+               addmg = 0;
                 require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
                 require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
+           }
 
             break;
        }
        case '*':               /* $* */
        case '#':               /* $# */
            if (sv_type == SVt_PV)
 
             break;
        }
        case '*':               /* $* */
        case '#':               /* $# */
            if (sv_type == SVt_PV)
+               /* diag_listed_as: $* is no longer supported */
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
-       case '|':               /* $| */
-           sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
-           goto magicalize;
-
        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) {
+               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
+               require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+               addmg = 0;
+           }
+           else goto magicalize;
+            break;
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
@@ -1644,7 +1951,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '7':               /* $7 */
        case '8':               /* $8 */
        case '9':               /* $9 */
        case '7':               /* $7 */
        case '8':               /* $8 */
        case '9':               /* $9 */
-       case '[':               /* $[ */
        case '^':               /* $^ */
        case '~':               /* $~ */
        case '=':               /* $= */
        case '^':               /* $^ */
        case '~':               /* $~ */
        case '=':               /* $= */
@@ -1656,6 +1962,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '>':               /* $> */
        case '\\':              /* $\ */
        case '/':               /* $/ */
        case '>':               /* $> */
        case '\\':              /* $\ */
        case '/':               /* $/ */
+       case '|':               /* $| */
        case '$':               /* $$ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '$':               /* $$ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
@@ -1674,14 +1981,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
        case '\014':    /* $^L */
            sv_setpvs(GvSVn(gv),"\f");
 
        case '\014':    /* $^L */
            sv_setpvs(GvSVn(gv),"\f");
-           PL_formfeed = GvSVn(gv);
            break;
        case ';':               /* $; */
            sv_setpvs(GvSVn(gv),"\034");
            break;
        case ']':               /* $] */
        {
            break;
        case ';':               /* $; */
            sv_setpvs(GvSVn(gv),"\034");
            break;
        case ']':               /* $] */
        {
-           SV * const sv = GvSVn(gv);
+           SV * const sv = GvSV(gv);
            if (!sv_derived_from(PL_patchlevel, "version"))
                upg_version(PL_patchlevel, TRUE);
            GvSV(gv) = vnumify(PL_patchlevel);
            if (!sv_derived_from(PL_patchlevel, "version"))
                upg_version(PL_patchlevel, TRUE);
            GvSV(gv) = vnumify(PL_patchlevel);
@@ -1691,7 +1997,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        break;
        case '\026':    /* $^V */
        {
        break;
        case '\026':    /* $^V */
        {
-           SV * const sv = GvSVn(gv);
+           SV * const sv = GvSV(gv);
            GvSV(gv) = new_version(PL_patchlevel);
            SvREADONLY_on(GvSV(gv));
            SvREFCNT_dec(sv);
            GvSV(gv) = new_version(PL_patchlevel);
            SvREADONLY_on(GvSV(gv));
            SvREFCNT_dec(sv);
@@ -1699,6 +2005,15 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        break;
        }
     }
        break;
        }
     }
+  add_magical_gv:
+    if (addmg) {
+       if (GvAV(gv) || GvHV(gv) || GvIO(gv) || GvCV(gv) || (
+            GvSV(gv) && (SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)))
+          ))
+           (void)hv_store(stash,name,len,(SV *)gv,0);
+       else SvREFCNT_dec(gv), gv = NULL;
+    }
+    if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
     return gv;
 }
 
     return gv;
 }
 
@@ -1706,30 +2021,21 @@ void
 Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
 {
     const char *name;
 Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
 {
     const char *name;
-    STRLEN namelen;
     const HV * const hv = GvSTASH(gv);
 
     PERL_ARGS_ASSERT_GV_FULLNAME4;
 
     const HV * const hv = GvSTASH(gv);
 
     PERL_ARGS_ASSERT_GV_FULLNAME4;
 
-    if (!hv) {
-       SvOK_off(sv);
-       return;
-    }
     sv_setpv(sv, prefix ? prefix : "");
 
     sv_setpv(sv, prefix ? prefix : "");
 
-    name = HvNAME_get(hv);
-    if (name) {
-       namelen = HvNAMELEN_get(hv);
-    } else {
-       name = "__ANON__";
-       namelen = 8;
-    }
-
-    if (keepmain || strNE(name, "main")) {
-       sv_catpvn(sv,name,namelen);
+    if (hv && (name = HvNAME(hv))) {
+      const STRLEN len = HvNAMELEN(hv);
+      if (keepmain || strnNE(name, "main", len)) {
+       sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES);
        sv_catpvs(sv,"::");
        sv_catpvs(sv,"::");
+      }
     }
     }
-    sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
+    else sv_catpvs(sv,"__ANON__::");
+    sv_catsv(sv,sv_2mortal(newSVhek(GvNAME_HEK(gv))));
 }
 
 void
 }
 
 void
@@ -1746,7 +2052,7 @@ void
 Perl_gv_check(pTHX_ const HV *stash)
 {
     dVAR;
 Perl_gv_check(pTHX_ const HV *stash)
 {
     dVAR;
-    register I32 i;
+    I32 i;
 
     PERL_ARGS_ASSERT_GV_CHECK;
 
 
     PERL_ARGS_ASSERT_GV_CHECK;
 
@@ -1755,7 +2061,7 @@ Perl_gv_check(pTHX_ const HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
-            register GV *gv;
+            GV *gv;
             HV *hv;
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
                (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
             HV *hv;
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
                (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
@@ -1763,7 +2069,8 @@ Perl_gv_check(pTHX_ const HV *stash)
                if (hv != PL_defstash && hv != stash)
                     gv_check(hv);              /* nested package */
            }
                if (hv != PL_defstash && hv != stash)
                     gv_check(hv);              /* nested package */
            }
-           else if (isALPHA(*HeKEY(entry))) {
+            else if ( *HeKEY(entry) != '_'
+                        && isIDFIRST_lazy_if(HeKEY(entry), HeUTF8(entry)) ) {
                 const char *file;
                gv = MUTABLE_GV(HeVAL(entry));
                if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
                 const char *file;
                gv = MUTABLE_GV(HeVAL(entry));
                if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
@@ -1777,22 +2084,26 @@ Perl_gv_check(pTHX_ const HV *stash)
                    = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
 #endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
                    = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
 #endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
-                       "Name \"%s::%s\" used only once: possible typo",
-                       HvNAME_get(stash), GvNAME(gv));
+                       "Name \"%"HEKf"::%"HEKf
+                       "\" used only once: possible typo",
+                            HEKfARG(HvNAME_HEK(stash)),
+                            HEKfARG(GvNAME_HEK(gv)));
            }
        }
     }
 }
 
 GV *
            }
        }
     }
 }
 
 GV *
-Perl_newGVgen(pTHX_ const char *pack)
+Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
 {
     dVAR;
 {
     dVAR;
+    PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
 
 
-    PERL_ARGS_ASSERT_NEWGVGEN;
-
-    return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
-                     GV_ADD, SVt_PVGV);
+    return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::_GEN_%ld",
+                                    SVfARG(newSVpvn_flags(pack, strlen(pack),
+                                            SVs_TEMP | flags)),
+                                (long)PL_gensym++),
+                      GV_ADD, SVt_PVGV);
 }
 
 /* hopefully this is only called on local symbol table entries */
 }
 
 /* hopefully this is only called on local symbol table entries */
@@ -1866,10 +2177,12 @@ Perl_gp_free(pTHX_ GV *gv)
       /* FIXME - another reference loop GV -> symtab -> GV ?
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
       /* FIXME - another reference loop GV -> symtab -> GV ?
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
-       const char *hvname = HvNAME_get(hv);
-       if (PL_stashcache && hvname)
-           (void)hv_delete(PL_stashcache, hvname, HvNAMELEN_get(hv),
-                     G_DISCARD);
+        const HEK *hvname_hek = HvNAME_HEK(hv);
+        DEBUG_o(Perl_deb(aTHX_ "gp_free clearing PL_stashcache for '%"HEKf"'\n", hvname_hek));
+        if (PL_stashcache && hvname_hek)
+           (void)hv_delete(PL_stashcache, HEK_KEY(hvname_hek),
+                      (HEK_UTF8(hvname_hek) ? -HEK_LEN(hvname_hek) : HEK_LEN(hvname_hek)),
+                      G_DISCARD);
        SvREFCNT_dec(hv);
       }
       SvREFCNT_dec(io);
        SvREFCNT_dec(hv);
       }
       SvREFCNT_dec(io);
@@ -1938,8 +2251,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen;
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
   newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen;
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
-      if (amtp->was_ok_am == PL_amagic_generation
-         && amtp->was_ok_sub == newgen) {
+      if (amtp->was_ok_sub == newgen) {
          return AMT_OVERLOADED(amtp) ? 1 : 0;
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
          return AMT_OVERLOADED(amtp) ? 1 : 0;
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
@@ -1948,7 +2260,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) );
 
   Zero(&amt,1,AMT);
   DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) );
 
   Zero(&amt,1,AMT);
-  amt.was_ok_am = PL_amagic_generation;
   amt.was_ok_sub = newgen;
   amt.fallback = AMGfallNO;
   amt.flags = 0;
   amt.was_ok_sub = newgen;
   amt.fallback = AMGfallNO;
   amt.flags = 0;
@@ -1960,21 +2271,33 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
     /* Try to find via inheritance. */
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
     /* Try to find via inheritance. */
-    GV *gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
+    GV *gv = gv_fetchmeth_pvn(stash, PL_AMG_names[0], 2, -1, 0);
     SV * const sv = gv ? GvSV(gv) : NULL;
     CV* cv;
 
     if (!gv)
     SV * const sv = gv ? GvSV(gv) : NULL;
     CV* cv;
 
     if (!gv)
+    {
+      if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0))
        lim = DESTROY_amg;              /* Skip overloading entries. */
        lim = DESTROY_amg;              /* Skip overloading entries. */
+    }
 #ifdef PERL_DONT_CREATE_GVSV
     else if (!sv) {
        NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
     }
 #endif
     else if (SvTRUE(sv))
 #ifdef PERL_DONT_CREATE_GVSV
     else if (!sv) {
        NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
     }
 #endif
     else if (SvTRUE(sv))
+        /* don't need to set overloading here because fallback => 1
+         * is the default setting for classes without overloading */
        amt.fallback=AMGfallYES;
        amt.fallback=AMGfallYES;
-    else if (SvOK(sv))
+    else if (SvOK(sv)) {
        amt.fallback=AMGfallNEVER;
        amt.fallback=AMGfallNEVER;
+        filled = 1;
+        have_ovl = 1;
+    }
+    else {
+        filled = 1;
+        have_ovl = 1;
+    }
 
     for (i = 1; i < lim; i++)
        amt.table[i] = NULL;
 
     for (i = 1; i < lim; i++)
        amt.table[i] = NULL;
@@ -1994,14 +2317,15 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
           But if B overloads "bool", we may want to use it for
           numifying instead of C's "+0". */
        if (i >= DESTROY_amg)
           But if B overloads "bool", we may want to use it for
           numifying instead of C's "+0". */
        if (i >= DESTROY_amg)
-           gv = Perl_gv_fetchmeth_autoload(aTHX_ stash, cooky, l, 0);
+           gv = Perl_gv_fetchmeth_pvn_autoload(aTHX_ stash, cooky, l, 0, 0);
        else                            /* Autoload taken care of below */
        else                            /* Autoload taken care of below */
-           gv = Perl_gv_fetchmeth(aTHX_ stash, cooky, l, -1);
+           gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
         cv = 0;
         if (gv && (cv = GvCV(gv))) {
         cv = 0;
         if (gv && (cv = GvCV(gv))) {
-           const char *hvname;
-           if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
-               && strEQ(hvname = HvNAME_get(GvSTASH(CvGV(cv))), "overload")) {
+           if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){
+             const char * const hvname = HvNAME_get(GvSTASH(CvGV(cv)));
+             if (hvname && HEK_LEN(HvNAME_HEK(GvSTASH(CvGV(cv)))) == 8
+              && strEQ(hvname, "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. */
@@ -2010,25 +2334,32 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
 
                DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
                        "\" for overloaded \"%s\" in package \"%.256s\"\n",
 
                DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
                        "\" for overloaded \"%s\" in package \"%.256s\"\n",
-                            (void*)GvSV(gv), cp, hvname) );
+                            (void*)GvSV(gv), cp, HvNAME(stash)) );
                if (!gvsv || !SvPOK(gvsv)
                if (!gvsv || !SvPOK(gvsv)
-                   || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
-                                                      FALSE)))
+                   || !(ngv = gv_fetchmethod_sv_flags(stash, gvsv, 0)))
                {
                    /* Can be an import stub (created by "can"). */
                    if (destructing) {
                        return -1;
                    }
                    else {
                {
                    /* Can be an import stub (created by "can"). */
                    if (destructing) {
                        return -1;
                    }
                    else {
-                       const char * const name = (gvsv && SvPOK(gvsv)) ?  SvPVX_const(gvsv) : "???";
-                       Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
-                                   "in package \"%.256s\"",
+                       const SV * const name = (gvsv && SvPOK(gvsv))
+                                                    ? gvsv
+                                                    : newSVpvs_flags("???", SVs_TEMP);
+                       /* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */
+                       Perl_croak(aTHX_ "%s method \"%"SVf256
+                                   "\" overloading \"%s\" "\
+                                   "in package \"%"HEKf256"\"",
                                   (GvCVGEN(gv) ? "Stub found while resolving"
                                    : "Can't resolve"),
                                   (GvCVGEN(gv) ? "Stub found while resolving"
                                    : "Can't resolve"),
-                                  name, cp, hvname);
+                                  SVfARG(name), cp,
+                                   HEKfARG(
+                                       HvNAME_HEK(stash)
+                                  ));
                    }
                }
                cv = GvCV(gv = ngv);
                    }
                }
                cv = GvCV(gv = ngv);
+             }
            }
            DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n",
                         cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
            }
            DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n",
                         cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
@@ -2095,8 +2426,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     }
     assert(mg);
     amtp = (AMT*)mg->mg_ptr;
     }
     assert(mg);
     amtp = (AMT*)mg->mg_ptr;
-    if ( amtp->was_ok_am != PL_amagic_generation
-        || amtp->was_ok_sub != newgen )
+    if ( amtp->was_ok_sub != newgen )
        goto do_update;
     if (AMT_AMAGIC(amtp)) {
        CV * const ret = amtp->table[id];
        goto do_update;
     if (AMT_AMAGIC(amtp)) {
        CV * const ret = amtp->table[id];
@@ -2242,6 +2572,31 @@ Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
     return tmpsv ? tmpsv : ref;
 }
 
     return tmpsv ? tmpsv : ref;
 }
 
+bool
+Perl_amagic_is_enabled(pTHX_ int method)
+{
+      SV *lex_mask = cop_hints_fetch_pvs(PL_curcop, "overloading", 0);
+
+      assert(PL_curcop->cop_hints & HINT_NO_AMAGIC);
+
+      if ( !lex_mask || !SvOK(lex_mask) )
+         /* overloading lexically disabled */
+         return FALSE;
+      else if ( lex_mask && SvPOK(lex_mask) ) {
+         /* we have an entry in the hints hash, check if method has been
+          * masked by overloading.pm */
+         STRLEN len;
+         const int offset = method / 8;
+         const int bit    = method % 8;
+         char *pv = SvPV(lex_mask, len);
+
+         /* Bit set, so this overloading operator is disabled */
+         if ( (STRLEN)offset < len && pv[offset] & ( 1 << bit ) )
+             return FALSE;
+      }
+      return TRUE;
+}
+
 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)
 {
@@ -2255,6 +2610,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   int assign = AMGf_assign & flags;
   const int assignshift = assign ? 1 : 0;
   int use_default_op = 0;
   int assign = AMGf_assign & flags;
   const int assignshift = assign ? 1 : 0;
   int use_default_op = 0;
+  int force_scalar = 0;
 #ifdef DEBUGGING
   int fl=0;
 #endif
 #ifdef DEBUGGING
   int fl=0;
 #endif
@@ -2263,27 +2619,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   PERL_ARGS_ASSERT_AMAGIC_CALL;
 
   if ( PL_curcop->cop_hints & HINT_NO_AMAGIC ) {
   PERL_ARGS_ASSERT_AMAGIC_CALL;
 
   if ( PL_curcop->cop_hints & HINT_NO_AMAGIC ) {
-      SV *lex_mask = cop_hints_fetch_pvs(PL_curcop, "overloading", 0);
-
-      if ( !lex_mask || !SvOK(lex_mask) )
-         /* overloading lexically disabled */
-         return NULL;
-      else if ( lex_mask && SvPOK(lex_mask) ) {
-         /* we have an entry in the hints hash, check if method has been
-          * masked by overloading.pm */
-         STRLEN len;
-         const int offset = method / 8;
-         const int bit    = method % 8;
-         char *pv = SvPV(lex_mask, len);
-
-         /* Bit set, so this overloading operator is disabled */
-         if ( (STRLEN)offset < len && pv[offset] & ( 1 << bit ) )
-             return NULL;
-      }
+      if (!amagic_is_enabled(method)) return NULL;
   }
 
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
   }
 
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
-      && (stash = SvSTASH(SvRV(left)))
+      && (stash = SvSTASH(SvRV(left))) && Gv_AMG(stash)
       && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
       && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
@@ -2348,12 +2688,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                 */
                SV* const newref = newSVsv(tmpRef);
                SvOBJECT_on(newref);
                 */
                SV* const newref = newSVsv(tmpRef);
                SvOBJECT_on(newref);
-               /* As a bit of a source compatibility hack, SvAMAGIC() and
-                  friends dereference an RV, to behave the same was as when
-                  overloading was stored on the reference, not the referant.
-                  Hence we can't use SvAMAGIC_on()
-               */
-               SvFLAGS(newref) |= SVf_AMAGIC;
+               /* No need to do SvAMAGIC_on here, as SvAMAGIC macros
+                  delegate to the stash. */
                SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef))));
                return newref;
             }
                SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef))));
                return newref;
             }
@@ -2410,14 +2746,21 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
         }
         if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
         }
         if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
-              && (stash = SvSTASH(SvRV(right)))
+              && (stash = SvSTASH(SvRV(right))) && Gv_AMG(stash)
               && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : NULL))
               && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : NULL))
-              && (cv = cvp[off=method])) { /* Method for right
-                                            * argument found */
-      lr=1;
+              && ((cv = cvp[off=method+assignshift])
+                  || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
+                                                                  * usual method */
+                      (
+#ifdef DEBUGGING
+                       fl = 1,
+#endif
+                       cv = cvp[off=method])))) { /* Method for right
+                                                   * argument found */
+       lr=1;
     } else if (((cvp && amtp->fallback > AMGfallNEVER)
                 || (ocvp && oamtp->fallback > AMGfallNEVER))
               && !(flags & AMGf_unary)) {
     } else if (((cvp && amtp->fallback > AMGfallNEVER)
                 || (ocvp && oamtp->fallback > AMGfallNEVER))
               && !(flags & AMGf_unary)) {
@@ -2487,25 +2830,25 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        SV *msg;
        if (off==-1) off=method;
        msg = sv_2mortal(Perl_newSVpvf(aTHX_
        SV *msg;
        if (off==-1) off=method;
        msg = sv_2mortal(Perl_newSVpvf(aTHX_
-                     "Operation \"%s\": no method found,%sargument %s%s%s%s",
-                     AMG_id2name(method + assignshift),
-                     (flags & AMGf_unary ? " " : "\n\tleft "),
-                     SvAMAGIC(left)?
-                       "in overloaded package ":
-                       "has no overloaded magic",
-                     SvAMAGIC(left)?
-                       HvNAME_get(SvSTASH(SvRV(left))):
-                       "",
-                     SvAMAGIC(right)?
-                       ",\n\tright argument in overloaded package ":
-                       (flags & AMGf_unary
-                        ? ""
-                        : ",\n\tright argument has no overloaded magic"),
-                     SvAMAGIC(right)?
-                       HvNAME_get(SvSTASH(SvRV(right))):
-                       ""));
+                     "Operation \"%s\": no method found,%sargument %s%"SVf"%s%"SVf,
+                     AMG_id2name(method + assignshift),
+                     (flags & AMGf_unary ? " " : "\n\tleft "),
+                     SvAMAGIC(left)?
+                       "in overloaded package ":
+                       "has no overloaded magic",
+                     SvAMAGIC(left)?
+                       SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(left)))))):
+                       SVfARG(&PL_sv_no),
+                     SvAMAGIC(right)?
+                       ",\n\tright argument in overloaded package ":
+                       (flags & AMGf_unary
+                        ? ""
+                        : ",\n\tright argument has no overloaded magic"),
+                     SvAMAGIC(right)?
+                       SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))):
+                       SVfARG(&PL_sv_no)));
         if (use_default_op) {
         if (use_default_op) {
-         DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
+         DEBUG_o( Perl_deb(aTHX_ "%"SVf, SVfARG(msg)) );
        } else {
          Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
        }
        } else {
          Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
        }
@@ -2514,10 +2857,68 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       force_cpy = force_cpy || assign;
     }
   }
       force_cpy = force_cpy || assign;
     }
   }
+
+  switch (method) {
+    /* in these cases, we're calling '+' or '-' as a fallback for a ++ or --
+     * operation. we need this to return a value, so that it can be assigned
+     * later on, in the postpr block (case inc_amg/dec_amg), even if the
+     * increment or decrement was itself called in void context */
+    case inc_amg:
+      if (off == add_amg)
+        force_scalar = 1;
+      break;
+    case dec_amg:
+      if (off == subtr_amg)
+        force_scalar = 1;
+      break;
+    /* in these cases, we're calling an assignment variant of an operator
+     * (+= rather than +, for instance). regardless of whether it's a
+     * fallback or not, it always has to return a value, which will be
+     * assigned to the proper variable later */
+    case add_amg:
+    case subtr_amg:
+    case mult_amg:
+    case div_amg:
+    case modulo_amg:
+    case pow_amg:
+    case lshift_amg:
+    case rshift_amg:
+    case repeat_amg:
+    case concat_amg:
+    case band_amg:
+    case bor_amg:
+    case bxor_amg:
+      if (assign)
+        force_scalar = 1;
+      break;
+    /* the copy constructor always needs to return a value */
+    case copy_amg:
+      force_scalar = 1;
+      break;
+    /* because of the way these are implemented (they don't perform the
+     * dereferencing themselves, they return a reference that perl then
+     * dereferences later), they always have to be in scalar context */
+    case to_sv_amg:
+    case to_av_amg:
+    case to_hv_amg:
+    case to_gv_amg:
+    case to_cv_amg:
+      force_scalar = 1;
+      break;
+    /* these don't have an op of their own; they're triggered by their parent
+     * op, so the context there isn't meaningful ('$a and foo()' in void
+     * context still needs to pass scalar context on to $a's bool overload) */
+    case bool__amg:
+    case numer_amg:
+    case string_amg:
+      force_scalar = 1;
+      break;
+  }
+
 #ifdef DEBUGGING
   if (!notfound) {
     DEBUG_o(Perl_deb(aTHX_
 #ifdef DEBUGGING
   if (!notfound) {
     DEBUG_o(Perl_deb(aTHX_
-                    "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %s%s\n",
+                    "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %"SVf"%s\n",
                     AMG_id2name(off),
                     method+assignshift==off? "" :
                     " (initially \"",
                     AMG_id2name(off),
                     method+assignshift==off? "" :
                     " (initially \"",
@@ -2527,7 +2928,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                     flags & AMGf_unary? "" :
                     lr==1 ? " for right argument": " for left argument",
                     flags & AMGf_unary? " for argument" : "",
                     flags & AMGf_unary? "" :
                     lr==1 ? " for right argument": " for left argument",
                     flags & AMGf_unary? " for argument" : "",
-                    stash ? HvNAME_get(stash) : "null",
+                    stash ? SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))) : SVfARG(newSVpvs_flags("null", SVs_TEMP)),
                     fl? ",\n\tassignment variant used": "") );
   }
 #endif
                     fl? ",\n\tassignment variant used": "") );
   }
 #endif
@@ -2553,9 +2954,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     /* off is method, method+assignshift, or a result of opcode substitution.
      * In the latter case assignshift==0, so only notfound case is important.
      */
     /* off is method, method+assignshift, or a result of opcode substitution.
      * In the latter case assignshift==0, so only notfound case is important.
      */
-  if (( (method + assignshift == off)
+  if ( (lr == -1) && ( ( (method + assignshift == off)
        && (assign || (method == inc_amg) || (method == dec_amg)))
        && (assign || (method == inc_amg) || (method == dec_amg)))
-      || force_cpy)
+      || force_cpy) )
   {
       /* newSVsv does not behave as advertised, so we copy missing
        * information by hand */
   {
       /* newSVsv does not behave as advertised, so we copy missing
        * information by hand */
@@ -2573,12 +2974,29 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     BINOP myop;
     SV* res;
     const bool oldcatch = CATCH_GET;
     BINOP myop;
     SV* res;
     const bool oldcatch = CATCH_GET;
+    I32 oldmark, nret;
+    int gimme = force_scalar ? G_SCALAR : GIMME_V;
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = NULL;
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = NULL;
-    myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
+    myop.op_flags = OPf_STACKED;
+
+    switch (gimme) {
+        case G_VOID:
+            myop.op_flags |= OPf_WANT_VOID;
+            break;
+        case G_ARRAY:
+            if (flags & AMGf_want_list) {
+                myop.op_flags |= OPf_WANT_LIST;
+                break;
+            }
+            /* FALLTHROUGH */
+        default:
+            myop.op_flags |= OPf_WANT_SCALAR;
+            break;
+    }
 
     PUSHSTACKi(PERLSI_OVERLOAD);
     ENTER;
 
     PUSHSTACKi(PERLSI_OVERLOAD);
     ENTER;
@@ -2599,13 +3017,37 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     }
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
     }
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
+    oldmark = TOPMARK;
 
     if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX)))
       CALLRUNOPS(aTHX);
     LEAVE;
     SPAGAIN;
 
     if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX)))
       CALLRUNOPS(aTHX);
     LEAVE;
     SPAGAIN;
+    nret = SP - (PL_stack_base + oldmark);
+
+    switch (gimme) {
+        case G_VOID:
+            /* returning NULL has another meaning, and we check the context
+             * at the call site too, so this can be differentiated from the
+             * scalar case */
+            res = &PL_sv_undef;
+            SP = PL_stack_base + oldmark;
+            break;
+        case G_ARRAY: {
+            if (flags & AMGf_want_list) {
+                res = sv_2mortal((SV *)newAV());
+                av_extend((AV *)res, nret);
+                while (nret--)
+                    av_store((AV *)res, nret, POPs);
+                break;
+            }
+            /* FALLTHROUGH */
+        }
+        default:
+            res = POPs;
+            break;
+    }
 
 
-    res=POPs;
     PUTBACK;
     POPSTACK;
     CATCH_SET(oldcatch);
     PUTBACK;
     POPSTACK;
     CATCH_SET(oldcatch);
@@ -2651,146 +3093,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   }
 }
 
   }
 }
 
-/*
-=for apidoc is_gv_magical_sv
-
-Returns C<TRUE> if given the name of a magical GV.  Any get-magic that
-C<name_sv> has is ignored.
-
-Currently only useful internally when determining if a GV should be
-created even in rvalue contexts.
-
-C<flags> is not used at present but available for future extension to
-allow selecting particular classes of magical variable.
-
-=cut
-*/
-
-bool
-Perl_is_gv_magical_sv(pTHX_ SV *const name_sv, U32 flags)
-{
-    STRLEN len;
-    const char *const name = SvPV_nomg_const(name_sv, len);
-
-    PERL_UNUSED_ARG(flags);
-    PERL_ARGS_ASSERT_IS_GV_MAGICAL_SV;
-
-    if (len > 1) {
-       const char * const name1 = name + 1;
-       switch (*name) {
-       case 'I':
-           if (len == 3 && name[1] == 'S' && name[2] == 'A')
-               goto yes;
-           break;
-       case 'O':
-           if (len == 8 && strEQ(name1, "VERLOAD"))
-               goto yes;
-           break;
-       case 'S':
-           if (len == 3 && name[1] == 'I' && name[2] == 'G')
-               goto yes;
-           break;
-           /* Using ${^...} variables is likely to be sufficiently rare that
-              it seems sensible to avoid the space hit of also checking the
-              length.  */
-       case '\017':   /* ${^OPEN} */
-           if (strEQ(name1, "PEN"))
-               goto yes;
-           break;
-       case '\024':   /* ${^TAINT} */
-           if (strEQ(name1, "AINT"))
-               goto yes;
-           break;
-       case '\025':    /* ${^UNICODE} */
-           if (strEQ(name1, "NICODE"))
-               goto yes;
-           if (strEQ(name1, "TF8LOCALE"))
-               goto yes;
-           break;
-       case '\027':   /* ${^WARNING_BITS} */
-           if (strEQ(name1, "ARNING_BITS"))
-               goto yes;
-           break;
-       case '1':
-       case '2':
-       case '3':
-       case '4':
-       case '5':
-       case '6':
-       case '7':
-       case '8':
-       case '9':
-       {
-           const char *end = name + len;
-           while (--end > name) {
-               if (!isDIGIT(*end))
-                   return FALSE;
-           }
-           goto yes;
-       }
-       }
-    } else {
-       /* Because we're already assuming that name is NUL terminated
-          below, we can treat an empty name as "\0"  */
-       switch (*name) {
-       case '&':
-       case '`':
-       case '\'':
-       case ':':
-       case '?':
-       case '!':
-       case '-':
-       case '#':
-       case '[':
-       case '^':
-       case '~':
-       case '=':
-       case '%':
-       case '.':
-       case '(':
-       case ')':
-       case '<':
-       case '>':
-       case '\\':
-       case '/':
-       case '$':
-       case '|':
-       case '+':
-       case ';':
-       case ']':
-       case '\001':   /* $^A */
-       case '\003':   /* $^C */
-       case '\004':   /* $^D */
-       case '\005':   /* $^E */
-       case '\006':   /* $^F */
-       case '\010':   /* $^H */
-       case '\011':   /* $^I, NOT \t in EBCDIC */
-       case '\014':   /* $^L */
-       case '\016':   /* $^N */
-       case '\017':   /* $^O */
-       case '\020':   /* $^P */
-       case '\023':   /* $^S */
-       case '\024':   /* $^T */
-       case '\026':   /* $^V */
-       case '\027':   /* $^W */
-       case '1':
-       case '2':
-       case '3':
-       case '4':
-       case '5':
-       case '6':
-       case '7':
-       case '8':
-       case '9':
-       yes:
-           return TRUE;
-       default:
-           break;
-       }
-    }
-    return FALSE;
-}
-
 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)
 {
@@ -2798,7 +3100,6 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     U32 hash;
 
     PERL_ARGS_ASSERT_GV_NAME_SET;
     U32 hash;
 
     PERL_ARGS_ASSERT_GV_NAME_SET;
-    PERL_UNUSED_ARG(flags);
 
     if (len > I32_MAX)
        Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
 
     if (len > I32_MAX)
        Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
@@ -2808,7 +3109,7 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     }
 
     PERL_HASH(hash, name, len);
     }
 
     PERL_HASH(hash, name, len);
-    GvNAME_HEK(gv) = share_hek(name, len, hash);
+    GvNAME_HEK(gv) = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
 }
 
 /*
 }
 
 /*
@@ -2900,8 +3201,8 @@ core_xsub(pTHX_ CV* cv)
  * 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.