fix another CvMUTEXP() leak

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index cc520d6..4adce49 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -22,8 +22,7 @@
 EXT char rcsid[];
 
 GV *
 EXT char rcsid[];
 
 GV *

-gv_AVadd(gv)
-register GV *gv;
+gv_AVadd(register GV *gv)

 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for array");
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for array");


@@ -33,8 +32,7 @@ register GV *gv;
 }
 
 GV *
 }
 
 GV *

-gv_HVadd(gv)
-register GV *gv;
+gv_HVadd(register GV *gv)

 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for hash");
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for hash");


@@ -44,8 +42,7 @@ register GV *gv;
 }
 
 GV *
 }
 
 GV *

-gv_IOadd(gv)
-register GV *gv;
+gv_IOadd(register GV *gv)

 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for filehandle");
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        croak("Bad symbol for filehandle");


@@ -55,57 +52,91 @@ register GV *gv;
 }
 
 GV *
 }
 
 GV *

-gv_fetchfile(name)
-char *name;
+gv_fetchfile(char *name)

 {
 {

-    char tmpbuf[1200];
+    dTHR;
+    char smallbuf[256];
+    char *tmpbuf;

     STRLEN tmplen;
     GV *gv;
 
     STRLEN tmplen;
     GV *gv;
 

-    sprintf(tmpbuf, "_<%s", name);
-    tmplen = strlen(tmpbuf);
+    tmplen = strlen(name) + 2;
+    if (tmplen < sizeof smallbuf)
+       tmpbuf = smallbuf;
+    else
+       New(603, tmpbuf, tmplen + 1, char);
+    tmpbuf[0] = '_';
+    tmpbuf[1] = '<';
+    strcpy(tmpbuf + 2, name);

     gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
     if (!isGV(gv))
        gv_init(gv, defstash, tmpbuf, tmplen, FALSE);
     gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
     if (!isGV(gv))
        gv_init(gv, defstash, tmpbuf, tmplen, FALSE);

+    if (tmpbuf != smallbuf)
+       Safefree(tmpbuf);

     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
        GvMULTI_on(gv);
     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
        GvMULTI_on(gv);

-    if (perldb)
+    if (PERLDB_LINE)

        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
 }
 
 void
        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
 }
 
 void

-gv_init(gv, stash, name, len, multi)
-GV *gv;
-HV *stash;
-char *name;
-STRLEN len;
-int multi;
+gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)

 {
 {

+    dTHR;

     register GP *gp;
     register GP *gp;

+    bool doproto = SvTYPE(gv) > SVt_NULL;
+    char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;

 
     sv_upgrade((SV*)gv, SVt_PVGV);
 
     sv_upgrade((SV*)gv, SVt_PVGV);

-    if (SvLEN(gv))
-       Safefree(SvPVX(gv));
+    if (SvLEN(gv)) {
+       if (proto) {
+           SvPVX(gv) = NULL;
+           SvLEN(gv) = 0;
+           SvPOK_off(gv);
+       } else
+           Safefree(SvPVX(gv));
+    }

     Newz(602, gp, 1, GP);
     GvGP(gv) = gp_ref(gp);
     GvSV(gv) = NEWSV(72,0);
     GvLINE(gv) = curcop->cop_line;
     GvFILEGV(gv) = curcop->cop_filegv;
     Newz(602, gp, 1, GP);
     GvGP(gv) = gp_ref(gp);
     GvSV(gv) = NEWSV(72,0);
     GvLINE(gv) = curcop->cop_line;
     GvFILEGV(gv) = curcop->cop_filegv;

+    GvCVGEN(gv) = 0;

     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, '*', name, len);
     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, '*', name, len);

-    GvSTASH(gv) = stash;
+    GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);

     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
        GvMULTI_on(gv);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
        GvMULTI_on(gv);

+    if (doproto) {                     /* Replicate part of newSUB here. */
+       SvIOK_off(gv);
+       ENTER;
+       start_subparse(0,0);            /* Create CV in compcv. */
+       GvCV(gv) = compcv;
+       LEAVE;
+
+       sub_generation++;
+       CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+       CvFILEGV(GvCV(gv)) = curcop->cop_filegv;
+       CvSTASH(GvCV(gv)) = curstash;
+#ifdef USE_THREADS
+       CvOWNER(GvCV(gv)) = 0;
+       if (!CvMUTEXP(GvCV(gv)))
+           New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
+       MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+#endif /* USE_THREADS */
+       if (proto) {
+           sv_setpv((SV*)GvCV(gv), proto);
+           Safefree(proto);
+       }
+    }

 }
 
 }
 

-static void
-gv_init_sv(gv, sv_type)
-GV* gv;
-I32 sv_type;
+STATIC void
+gv_init_sv(GV *gv, I32 sv_type)

 {
     switch (sv_type) {
     case SVt_PVIO:
 {
     switch (sv_type) {
     case SVt_PVIO:


@@ -121,11 +152,7 @@ I32 sv_type;
 }
 
 GV *
 }
 
 GV *

-gv_fetchmeth(stash, name, len, level)
-HV* stash;
-char* name;
-STRLEN len;
-I32 level;
+gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)

 {
     AV* av;
     GV* topgv;
 {
     AV* av;
     GV* topgv;


@@ -136,7 +163,8 @@ I32 level;
     if (!stash)
        return 0;
     if ((level > 100) || (level < -100))
     if (!stash)
        return 0;
     if ((level > 100) || (level < -100))

-       croak("Recursive inheritance detected");
+       croak("Recursive inheritance detected while looking for method '%s' in package '%s'",
+             name, HvNAME(stash));

 
     DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
 
 
     DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
 


@@ -149,20 +177,22 @@ I32 level;
            gv_init(topgv, stash, name, len, TRUE);
        if (cv = GvCV(topgv)) {
            /* If genuine method or valid cache entry, use it */
            gv_init(topgv, stash, name, len, TRUE);
        if (cv = GvCV(topgv)) {
            /* If genuine method or valid cache entry, use it */

-           if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
+           if (!GvCVGEN(topgv) || GvCVGEN(topgv) == sub_generation)

                return topgv;
            /* Stale cached entry: junk it */
            SvREFCNT_dec(cv);
            GvCV(topgv) = cv = Nullcv;
            GvCVGEN(topgv) = 0;
        }
                return topgv;
            /* Stale cached entry: junk it */
            SvREFCNT_dec(cv);
            GvCV(topgv) = cv = Nullcv;
            GvCVGEN(topgv) = 0;
        }

+       else if (GvCVGEN(topgv) == sub_generation)
+           return 0;  /* cache indicates sub doesn't exist */

     }
 
     gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
     av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
 
     }
 
     gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
     av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
 

-    /* create @.*::SUPER::ISA on demand */
-    if (!av) {
+    /* create and re-create @.*::SUPER::ISA on demand */
+    if (!av || !SvMAGIC(av)) {

        char* packname = HvNAME(stash);
        STRLEN packlen = strlen(packname);
 
        char* packname = HvNAME(stash);
        STRLEN packlen = strlen(packname);
 


@@ -173,6 +203,7 @@ I32 level;
            basestash = gv_stashpvn(packname, packlen, TRUE);
            gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
            if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
            basestash = gv_stashpvn(packname, packlen, TRUE);
            gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
            if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {

+               dTHR;           /* just for SvREFCNT_dec */

                gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
                if (!gvp || !(gv = *gvp))
                    croak("Cannot create %s::ISA", HvNAME(stash));
                gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
                if (!gvp || !(gv = *gvp))
                    croak("Cannot create %s::ISA", HvNAME(stash));


@@ -186,7 +217,8 @@ I32 level;
 
     if (av) {
        SV** svp = AvARRAY(av);
 
     if (av) {
        SV** svp = AvARRAY(av);

-       I32 items = AvFILL(av) + 1;
+       /* NOTE: No support for tied ISA */
+       I32 items = AvFILLp(av) + 1;

        while (items--) {
            SV* sv = *svp++;
            HV* basestash = gv_stashsv(sv, FALSE);
        while (items--) {
            SV* sv = *svp++;
            HV* basestash = gv_stashsv(sv, FALSE);


@@ -212,8 +244,16 @@ I32 level;
            if (gv = gv_fetchmeth(lastchance, name, len,
                                  (level >= 0) ? level + 1 : level - 1)) {
          gotcha:
            if (gv = gv_fetchmeth(lastchance, name, len,
                                  (level >= 0) ? level + 1 : level - 1)) {
          gotcha:

-               /* Use topgv for cache only if it has no synonyms */
-               if (topgv && GvREFCNT(topgv) == 1) {
+               /*
+                * Cache method in topgv if:
+                *  1. topgv has no synonyms (else inheritance crosses wires)
+                *  2. method isn't a stub (else AUTOLOAD fails spectacularly)
+                */
+               if (topgv &&
+                   GvREFCNT(topgv) == 1 &&
+                   (cv = GvCV(gv)) &&
+                   (CvROOT(cv) || CvXSUB(cv)))
+               {

                    if (cv = GvCV(topgv))
                        SvREFCNT_dec(cv);
                    GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
                    if (cv = GvCV(topgv))
                        SvREFCNT_dec(cv);
                    GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));


@@ -221,6 +261,10 @@ I32 level;
                }
                return gv;
            }
                }
                return gv;
            }

+           else if (topgv && GvREFCNT(topgv) == 1) {
+               /* cache the fact that the method is not defined */
+               GvCVGEN(topgv) = sub_generation;
+           }

        }
     }
 
        }
     }
 


@@ -228,10 +272,15 @@ I32 level;
 }
 
 GV *
 }
 
 GV *

-gv_fetchmethod(stash, name)
-HV* stash;
-char* name;
+gv_fetchmethod(HV *stash, char *name)
+{
+    return gv_fetchmethod_autoload(stash, name, TRUE);
+}
+
+GV *
+gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)

 {
 {

+    dTHR;

     register char *nend;
     char *nsplit = 0;
     GV* gv;
     register char *nend;
     char *nsplit = 0;
     GV* gv;


@@ -249,8 +298,8 @@ char* name;
            --nsplit;
        if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
            --nsplit;
        if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */

-           SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash), 0));
-           sv_catpvn(tmpstr, "::SUPER", 7);
+           SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER",
+                                            HvNAME(curcop->cop_stash)));

            stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
            DEBUG_o( deb("Treating %s as %s::%s\n",
                         origname, HvNAME(stash), name) );
            stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
            DEBUG_o( deb("Treating %s as %s::%s\n",
                         origname, HvNAME(stash), name) );


@@ -263,18 +312,34 @@ char* name;
     if (!gv) {
        if (strEQ(name,"import"))
            gv = (GV*)&sv_yes;
     if (!gv) {
        if (strEQ(name,"import"))
            gv = (GV*)&sv_yes;

-       else
-           gv = gv_autoload(stash, name, nend - name);
+       else if (autoload)
+           gv = gv_autoload4(stash, name, nend - name, TRUE);
+    }
+    else if (autoload) {
+       CV* cv = GvCV(gv);
+       if (!CvROOT(cv) && !CvXSUB(cv)) {
+           GV* stubgv;
+           GV* autogv;
+
+           if (CvANON(cv))
+               stubgv = gv;
+           else {
+               stubgv = CvGV(cv);
+               if (GvCV(stubgv) != cv)         /* orphaned import */
+                   stubgv = gv;
+           }
+           autogv = gv_autoload4(GvSTASH(stubgv),
+                                 GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
+           if (autogv)
+               gv = autogv;
+       }

     }
 
     return gv;
 }
 
 GV*
     }
 
     return gv;
 }
 
 GV*

-gv_autoload(stash, name, len)
-HV* stash;
-char* name;
-STRLEN len;
+gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)

 {
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;
 {
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;


@@ -286,11 +351,19 @@ STRLEN len;
 
     if (len == autolen && strnEQ(name, autoload, autolen))
        return Nullgv;
 
     if (len == autolen && strnEQ(name, autoload, autolen))
        return Nullgv;

-    if (!(gv = gv_fetchmeth(stash, autoload, autolen, 0)))
+    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))

        return Nullgv;
     cv = GvCV(gv);
 
     /*
        return Nullgv;
     cv = GvCV(gv);
 
     /*

+     * Inheriting AUTOLOAD for non-methods works ... for now.
+     */
+    if (dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
+       warn(
+         "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
+            HvNAME(stash), (int)len, name);
+
+    /*

      * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
      * The subroutine's original name may not be "AUTOLOAD", so we don't
      * use that, but for lack of anything better we will use the sub's
      * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
      * The subroutine's original name may not be "AUTOLOAD", so we don't
      * use that, but for lack of anything better we will use the sub's


@@ -309,36 +382,30 @@ STRLEN len;
 }
 
 HV*
 }
 
 HV*

-gv_stashpv(name,create)
-char *name;
-I32 create;
+gv_stashpv(char *name, I32 create)

 {
     return gv_stashpvn(name, strlen(name), create);
 }
 
 HV*
 {
     return gv_stashpvn(name, strlen(name), create);
 }
 
 HV*

-gv_stashpvn(name,namelen,create)
-char *name;
-U32 namelen;
-I32 create;
+gv_stashpvn(char *name, U32 namelen, I32 create)

 {
 {

-    char tmpbuf[1203];
+    char smallbuf[256];
+    char *tmpbuf;

     HV *stash;
     GV *tmpgv;
 
     HV *stash;
     GV *tmpgv;
 

-    if (namelen > 1200) {
-       namelen = 1200;
-#ifdef VMS
-       warn("Weird package name \"%s\" truncated", name);
-#else
-       warn("Weird package name \"%.*s...\" truncated", (int)namelen, name);
-#endif
-    }
+    if (namelen + 3 < sizeof smallbuf)
+       tmpbuf = smallbuf;
+    else
+       New(606, tmpbuf, namelen + 3, char);

     Copy(name,tmpbuf,namelen,char);
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen] = '\0';
     Copy(name,tmpbuf,namelen,char);
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen] = '\0';

-    tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
+    tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
+    if (tmpbuf != smallbuf)
+       Safefree(tmpbuf);

     if (!tmpgv)
        return 0;
     if (!GvHV(tmpgv))
     if (!tmpgv)
        return 0;
     if (!GvHV(tmpgv))


@@ -350,9 +417,7 @@ I32 create;
 }
 
 HV*
 }
 
 HV*

-gv_stashsv(sv,create)
-SV *sv;
-I32 create;
+gv_stashsv(SV *sv, I32 create)

 {
     register char *ptr;
     STRLEN len;
 {
     register char *ptr;
     STRLEN len;


@@ -362,11 +427,9 @@ I32 create;
 
 
 GV *
 
 
 GV *

-gv_fetchpv(nambeg,add,sv_type)
-char *nambeg;
-I32 add;
-I32 sv_type;
+gv_fetchpv(char *nambeg, I32 add, I32 sv_type)

 {
 {

+    dTHR;

     register char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;
     register char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;


@@ -374,7 +437,6 @@ I32 sv_type;
     register char *namend;
     HV *stash = 0;
     U32 add_gvflags = 0;
     register char *namend;
     HV *stash = 0;
     U32 add_gvflags = 0;

-    char *tmpbuf;

 
     if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
        name++;
 
     if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
        name++;


@@ -390,23 +452,29 @@ I32 sv_type;
 
            len = namend - name;
            if (len > 0) {
 
            len = namend - name;
            if (len > 0) {

-               New(601, tmpbuf, len+3, char);
+               char smallbuf[256];
+               char *tmpbuf;
+
+               if (len + 3 < sizeof smallbuf)
+                   tmpbuf = smallbuf;
+               else
+                   New(601, tmpbuf, len+3, char);

                Copy(name, tmpbuf, len, char);
                tmpbuf[len++] = ':';
                tmpbuf[len++] = ':';
                tmpbuf[len] = '\0';
                gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
                Copy(name, tmpbuf, len, char);
                tmpbuf[len++] = ':';
                tmpbuf[len++] = ':';
                tmpbuf[len] = '\0';
                gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);

-               Safefree(tmpbuf);
-               if (!gvp || *gvp == (GV*)&sv_undef)
-                   return Nullgv;
-               gv = *gvp;
-
-               if (SvTYPE(gv) == SVt_PVGV)
-                   GvMULTI_on(gv);
-               else if (!add)
+               gv = gvp ? *gvp : Nullgv;
+               if (gv && gv != (GV*)&sv_undef) {
+                   if (SvTYPE(gv) != SVt_PVGV)
+                       gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
+                   else
+                       GvMULTI_on(gv);
+               }
+               if (tmpbuf != smallbuf)
+                   Safefree(tmpbuf);
+               if (!gv || gv == (GV*)&sv_undef)

                    return Nullgv;
                    return Nullgv;

-               else
-                   gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));

 
                if (!(stash = GvHV(gv)))
                    stash = GvHV(gv) = newHV();
 
                if (!(stash = GvHV(gv)))
                    stash = GvHV(gv) = newHV();


@@ -500,17 +568,26 @@ I32 sv_type;
     /* By this point we should have a stash and a name */
 
     if (!stash) {
     /* By this point we should have a stash and a name */
 
     if (!stash) {

-       if (add) {
-           warn("Global symbol \"%s\" requires explicit package name", name);
-           ++error_count;
-           stash = curstash ? curstash : defstash;     /* avoid core dumps */
-           add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
-                          : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
-                          : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
-                          : 0);
-       }
-       else
+       if (!add)

            return Nullgv;
            return Nullgv;

+       if (add & ~GV_ADDMULTI) {
+           char sv_type_char = ((sv_type == SVt_PV) ? '$'
+                                : (sv_type == SVt_PVAV) ? '@'
+                                : (sv_type == SVt_PVHV) ? '%'
+                                : 0);
+           if (sv_type_char) 
+               warn("Global symbol \"%c%s\" requires explicit package name",
+                    sv_type_char, name);
+           else
+               warn("Global symbol \"%s\" requires explicit package name",
+                    name);
+       }
+       ++error_count;
+       stash = curstash ? curstash : defstash; /* avoid core dumps */
+       add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
+                      : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
+                      : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
+                      : 0);

     }
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */
     }
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */


@@ -526,13 +603,15 @@ I32 sv_type;
            gv_init_sv(gv, sv_type);
        }
        return gv;
            gv_init_sv(gv, sv_type);
        }
        return gv;

+    } else if (add & GV_NOINIT) {
+       return gv;

     }
 
     /* Adding a new symbol */
 
     }
 
     /* Adding a new symbol */
 

-    if (add & 4)
+    if (add & GV_ADDWARN)

        warn("Had to create %s unexpectedly", nambeg);
        warn("Had to create %s unexpectedly", nambeg);

-    gv_init(gv, stash, name, len, add & 2);
+    gv_init(gv, stash, name, len, add & GV_ADDMULTI);

     gv_init_sv(gv, sv_type);
     GvFLAGS(gv) |= add_gvflags;
 
     gv_init_sv(gv, sv_type);
     GvFLAGS(gv) |= add_gvflags;
 


@@ -558,7 +637,9 @@ I32 sv_type;
            AV* av = GvAVn(gv);
            GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
            AV* av = GvAVn(gv);
            GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);

-           if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
+           /* NOTE: No support for tied ISA */
+           if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
+               && AvFILLp(av) == -1)

            {
                char *pname;
                av_push(av, newSVpv(pname = "NDBM_File",0));
            {
                char *pname;
                av_push(av, newSVpv(pname = "NDBM_File",0));


@@ -579,7 +660,7 @@ I32 sv_type;
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
             GvMULTI_on(gv);
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
             GvMULTI_on(gv);

-            sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
+            hv_magic(hv, gv, 'A');

         }
         break;
 #endif /* OVERLOAD */
         }
         break;
 #endif /* OVERLOAD */


@@ -599,11 +680,6 @@ I32 sv_type;
                psig_ptr[i] = 0;
                psig_name[i] = 0;
            }
                psig_ptr[i] = 0;
                psig_name[i] = 0;
            }

-           /* initialize signal stack */
-           signalstack = newAV();
-           AvREAL_off(signalstack);
-           av_extend(signalstack, 30);
-           av_fill(signalstack, 0);

        }
        break;
 
        }
        break;
 


@@ -642,13 +718,28 @@ I32 sv_type;
 #endif
        goto magicalize;
 
 #endif
        goto magicalize;
 

+    case '!':
+       if (len > 1)
+           break;
+       if (sv_type > SVt_PV && curcop != &compiling) {
+           HV* stash = gv_stashpvn("Errno",5,FALSE);
+           if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+               dSP;
+               PUTBACK;
+               perl_require_pv("Errno.pm");
+               SPAGAIN;
+               stash = gv_stashpvn("Errno",5,FALSE);
+               if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
+                   croak("Can't use %%! because Errno.pm is not available");
+           }
+       }
+       goto magicalize;

     case '#':
     case '*':
        if (dowarn && len == 1 && sv_type == SVt_PV)
            warn("Use of $%s is deprecated", name);
        /* FALL THROUGH */
     case '[':
     case '#':
     case '*':
        if (dowarn && len == 1 && sv_type == SVt_PV)
            warn("Use of $%s is deprecated", name);
        /* FALL THROUGH */
     case '[':

-    case '!':

     case '^':
     case '~':
     case '=':
     case '^':
     case '~':
     case '=':


@@ -687,6 +778,7 @@ I32 sv_type;
     case '7':
     case '8':
     case '9':
     case '7':
     case '8':
     case '9':

+    case '\023':

       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize:
       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize:


@@ -718,10 +810,7 @@ I32 sv_type;
 }
 
 void
 }
 
 void

-gv_fullname3(sv, gv, prefix)
-SV *sv;
-GV *gv;
-char *prefix;
+gv_fullname3(SV *sv, GV *gv, char *prefix)

 {
     HV *hv = GvSTASH(gv);
     if (!hv) {
 {
     HV *hv = GvSTASH(gv);
     if (!hv) {


@@ -735,10 +824,7 @@ char *prefix;
 }
 
 void
 }
 
 void

-gv_efullname3(sv, gv, prefix)
-SV *sv;
-GV *gv;
-char *prefix;
+gv_efullname3(SV *sv, GV *gv, char *prefix)

 {
     GV *egv = GvEGV(gv);
     if (!egv)
 {
     GV *egv = GvEGV(gv);
     if (!egv)


@@ -748,25 +834,22 @@ char *prefix;
 
 /* XXX compatibility with versions <= 5.003. */
 void
 
 /* XXX compatibility with versions <= 5.003. */
 void

-gv_fullname(sv,gv)
-SV *sv;
-GV *gv;
+gv_fullname(SV *sv, GV *gv)

 {
     gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 /* XXX compatibility with versions <= 5.003. */
 void
 {
     gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 /* XXX compatibility with versions <= 5.003. */
 void

-gv_efullname(sv,gv)
-SV *sv;
-GV *gv;
+gv_efullname(SV *sv, GV *gv)

 {
     gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 IO *
 {
     gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 IO *

-newIO()
+newIO(void)

 {
 {

+    dTHR;

     IO *io;
     GV *iogv;
 
     IO *io;
     GV *iogv;
 


@@ -774,15 +857,17 @@ newIO()
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);

-    iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
+    iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
+    if (!iogv)
+      iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);

     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
 
 void
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
 
 void

-gv_check(stash)
-HV* stash;
+gv_check(HV *stash)

 {
 {

+    dTHR;

     register HE *entry;
     register I32 i;
     register GV *gv;
     register HE *entry;
     register I32 i;
     register GV *gv;


@@ -801,7 +886,7 @@ HV* stash;
            }
            else if (isALPHA(*HeKEY(entry))) {
                gv = (GV*)HeVAL(entry);
            }
            else if (isALPHA(*HeKEY(entry))) {
                gv = (GV*)HeVAL(entry);

-               if (GvMULTI(gv))
+               if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))

                    continue;
                curcop->cop_line = GvLINE(gv);
                filegv = GvFILEGV(gv);
                    continue;
                curcop->cop_line = GvLINE(gv);
                filegv = GvFILEGV(gv);


@@ -816,18 +901,16 @@ HV* stash;
 }
 
 GV *
 }
 
 GV *

-newGVgen(pack)
-char *pack;
+newGVgen(char *pack)

 {
 {

-    (void)sprintf(tokenbuf,"%s::_GEN_%ld",pack,(long)gensym++);
-    return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV);
+    return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)gensym++),
+                     TRUE, SVt_PVGV);

 }
 
 /* hopefully this is only called on local symbol table entries */
 
 GP*
 }
 
 /* hopefully this is only called on local symbol table entries */
 
 GP*

-gp_ref(gp)
-GP* gp;
+gp_ref(GP *gp)

 {
     gp->gp_refcnt++;
     if (gp->gp_cv) {
 {
     gp->gp_refcnt++;
     if (gp->gp_cv) {


@@ -846,8 +929,7 @@ GP* gp;
 }
 
 void
 }
 
 void

-gp_free(gv)
-GV* gv;
+gp_free(GV *gv)

 {
     GP* gp;
     CV* cv;
 {
     GP* gp;
     CV* cv;


@@ -907,15 +989,15 @@ register GV *gv;
 /* Updates and caches the CV's */
 
 bool
 /* Updates and caches the CV's */
 
 bool

-Gv_AMupdate(stash)
-HV* stash;
+Gv_AMupdate(HV *stash)

 {
 {

+  dTHR;  

   GV** gvp;
   HV* hv;
   GV* gv;
   CV* cv;
   MAGIC* mg=mg_find((SV*)stash,'c');
   GV** gvp;
   HV* hv;
   GV* gv;
   CV* cv;
   MAGIC* mg=mg_find((SV*)stash,'c');

-  AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
+  AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;

   AMT amt;
 
   if (mg && amtp->was_ok_am == amagic_generation
   AMT amt;
 
   if (mg && amtp->was_ok_am == amagic_generation


@@ -1012,16 +1094,13 @@ HV* stash;
     }
 
     for (i = 1; i < NofAMmeth; i++) {
     }
 
     for (i = 1; i < NofAMmeth; i++) {

-        cv = 0;
-        cp = AMG_names[i];
-      
-       *buf = '(';                     /* A cookie: "(". */
-       strcpy(buf + 1, cp);
+       SV *cookie = sv_2mortal(newSVpvf("(%s", cp = AMG_names[i]));

        DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
                     cp, HvNAME(stash)) );
        DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
                     cp, HvNAME(stash)) );

-       gv = gv_fetchmeth(stash, buf, strlen(buf), -1); /* no filling stash! */
+       /* don't fill the cache while looking up! */
+       gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1);
+        cv = 0;

         if(gv && (cv = GvCV(gv))) {
         if(gv && (cv = GvCV(gv))) {

-           char *name = buf;

            if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
                && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
                /* GvSV contains the name of the method. */
            if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
                && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
                /* GvSV contains the name of the method. */


@@ -1029,11 +1108,10 @@ HV* stash;
                
                DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
                             SvPV(GvSV(gv), na), cp, HvNAME(stash)) );
                
                DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
                             SvPV(GvSV(gv), na), cp, HvNAME(stash)) );

-               if (SvPOK(GvSV(gv)) 
-                   && (ngv = gv_fetchmethod(stash, SvPVX(GvSV(gv))))) {
-                   name = SvPVX(GvSV(gv));
-                   cv = GvCV(gv = ngv);
-               } else {
+               if (!SvPOK(GvSV(gv)) 
+                   || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
+                                                      FALSE)))
+               {

                    /* Can be an import stub (created by `can'). */
                    if (GvCVGEN(gv)) {
                        croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", 
                    /* Can be an import stub (created by `can'). */
                    if (GvCVGEN(gv)) {
                        croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", 


@@ -1044,9 +1122,7 @@ HV* stash;
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                }
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                }

-               /* If the sub is only a stub then we may have a gv to AUTOLOAD */
-               gv = (GV*)*hv_fetch(GvSTASH(gv), name, strlen(name), TRUE);
-               cv = GvCV(gv);
+               cv = GvCV(gv = ngv);

            }
            DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
                         cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
            }
            DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
                         cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),


@@ -1069,16 +1145,10 @@ HV* stash;
   return FALSE;
 }
 
   return FALSE;
 }
 

-/* During call to this subroutine stack can be reallocated. It is
- * advised to call SPAGAIN macro in your code after call */
-

 SV*
 SV*

-amagic_call(left,right,method,flags)
-SV* left;
-SV* right;
-int method;
-int flags; 
+amagic_call(SV *left, SV *right, int method, int flags)

 {
 {

+  dTHR;

   MAGIC *mg; 
   CV *cv; 
   CV **cvp=NULL, **ocvp=NULL;
   MAGIC *mg; 
   CV *cv; 
   CV **cvp=NULL, **ocvp=NULL;


@@ -1090,7 +1160,7 @@ int flags;
       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table

-                       : NULL))
+                       : (CV **) NULL))

       && ((cv = cvp[off=method+assignshift]) 
          || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
                                                          * usual method */
       && ((cv = cvp[off=method+assignshift]) 
          || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
                                                          * usual method */


@@ -1131,17 +1201,19 @@ int flags;
    break;
         case copy_amg:
           {
    break;
         case copy_amg:
           {

-            SV* ref=SvRV(left);
-            if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { /* Just to be
-                                                     * extra
-                                                     * causious,
-                                                     * maybe in some
-                                                     * additional
-                                                     * cases sv_setsv
-                                                     * is safe too */
-               SV* newref = newSVsv(ref);
+            /*
+                 * SV* ref causes confusion with the interpreter variable of
+                 * the same name
+                 */
+            SV* tmpRef=SvRV(left);
+            if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
+               /*
+                * Just to be extra cautious.  Maybe in some
+                * additional cases sv_setsv is safe, too.
+                */
+               SV* newref = newSVsv(tmpRef);

                SvOBJECT_on(newref);
                SvOBJECT_on(newref);

-               SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+               SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));

                return newref;
             }
           }
                return newref;
             }
           }


@@ -1185,7 +1257,7 @@ int flags;
               && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
                          ? (amtp = (AMT*)mg->mg_ptr)->table
               && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
                          ? (amtp = (AMT*)mg->mg_ptr)->table

-                         : NULL))
+                         : (CV **) NULL))

               && (cv = cvp[off=method])) { /* Method for right
                                             * argument found */
       lr=1;
               && (cv = cvp[off=method])) { /* Method for right
                                             * argument found */
       lr=1;


@@ -1195,7 +1267,7 @@ int flags;
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
                                 * comparison operations and
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
                                 * comparison operations and

-                                * concatendation */
+                                * concatenation */

       if (method==concat_amg || method==concat_ass_amg
          || method==repeat_amg || method==repeat_ass_amg) {
        return NULL;            /* Delegate operation to string conversion */
       if (method==concat_amg || method==concat_ass_amg
          || method==repeat_amg || method==repeat_ass_amg) {
        return NULL;            /* Delegate operation to string conversion */


@@ -1228,9 +1300,10 @@ int flags;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
        notfound = 1; lr = 1;
       } else {
       } else if (cvp && (cv=cvp[nomethod_amg])) {
        notfound = 1; lr = 1;
       } else {

+       SV *msg;

        if (off==-1) off=method;
        if (off==-1) off=method;

-       sprintf(buf,
-               "Operation `%s': no method found,%sargument %s%.256s%s%.256s",
+       msg = sv_2mortal(newSVpvf(
+                     "Operation `%s': no method found,%sargument %s%s%s%s",

                      AMG_names[method + assignshift],
                      (flags & AMGf_unary ? " " : "\n\tleft "),
                      SvAMAGIC(left)? 
                      AMG_names[method + assignshift],
                      (flags & AMGf_unary ? " " : "\n\tleft "),
                      SvAMAGIC(left)? 


@@ -1246,11 +1319,11 @@ int flags;
                         : ",\n\tright argument has no overloaded magic"),
                      SvAMAGIC(right)? 
                        HvNAME(SvSTASH(SvRV(right))):
                         : ",\n\tright argument has no overloaded magic"),
                      SvAMAGIC(right)? 
                        HvNAME(SvSTASH(SvRV(right))):

-                       "");
+                       ""));

        if (amtp && amtp->fallback >= AMGfallYES) {
        if (amtp && amtp->fallback >= AMGfallYES) {

-         DEBUG_o( deb(buf) );
+         DEBUG_o( deb("%s", SvPVX(msg)) );

        } else {
        } else {

-         croak(buf);
+         croak("%_", msg);

        }
        return NULL;
       }
        }
        return NULL;
       }


@@ -1258,7 +1331,7 @@ int flags;
   }
   if (!notfound) {
     DEBUG_o( deb(
   }
   if (!notfound) {
     DEBUG_o( deb(

-  "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
+  "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",

                 AMG_names[off],
                 method+assignshift==off? "" :
                             " (initially `",
                 AMG_names[off],
                 method+assignshift==off? "" :
                             " (initially `",


@@ -1282,40 +1355,41 @@ int flags;
     dSP;
     BINOP myop;
     SV* res;
     dSP;
     BINOP myop;
     SV* res;

-    bool oldmustcatch = mustcatch;
+    bool oldcatch = CATCH_GET;

 
 

+    CATCH_SET(TRUE);

     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;

-    myop.op_flags = OPf_KNOW|OPf_STACKED;
+    myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;

 
 

-    mustcatch = TRUE;
+    PUSHSTACKi(PERLSI_OVERLOAD);

     ENTER;
     ENTER;

-    SAVESPTR(op);
+    SAVEOP();

     op = (OP *) &myop;
     op = (OP *) &myop;

-    if (perldb && curstash != debstash)
+    if (PERLDB_SUB && curstash != debstash)

        op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
        op->op_private |= OPpENTERSUB_DB;
     PUTBACK;

-    pp_pushmark();
+    pp_pushmark(ARGS);

 
 

-    EXTEND(sp, notfound + 5);
+    EXTEND(SP, notfound + 5);

     PUSHs(lr>0? right: left);
     PUSHs(lr>0? left: right);
     PUSHs(lr>0? right: left);
     PUSHs(lr>0? left: right);

-    PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
+    PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no ));

     if (notfound) {
       PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) );
     }
     PUSHs((SV*)cv);
     PUTBACK;
 
     if (notfound) {
       PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) );
     }
     PUSHs((SV*)cv);
     PUTBACK;
 

-    if (op = pp_entersub())
-      runops();
+    if (op = pp_entersub(ARGS))
+      CALLRUNOPS();

     LEAVE;
     SPAGAIN;
 
     res=POPs;
     LEAVE;
     SPAGAIN;
 
     res=POPs;

-    PUTBACK;
-    mustcatch = oldmustcatch;
+    POPSTACK;
+    CATCH_SET(oldcatch);

 
     if (postpr) {
       int ans;
 
     if (postpr) {
       int ans;


@@ -1344,7 +1418,7 @@ int flags;
       case not_amg:
        ans=!SvOK(res); break;
       }
       case not_amg:
        ans=!SvOK(res); break;
       }

-      return ans? &sv_yes: &sv_no;
+      return boolSV(ans);

     } else if (method==copy_amg) {
       if (!SvROK(res)) {
        croak("Copy method did not return a reference");
     } else if (method==copy_amg) {
       if (!SvROK(res)) {
        croak("Copy method did not return a reference");


@@ -1356,3 +1430,4 @@ int flags;
   }
 }
 #endif /* OVERLOAD */
   }
 }
 #endif /* OVERLOAD */

+