X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1d2dff63f533f62282a700198c67c41dcb6ad6df..15041a678a73e91c0e4cece2b3fd5f83d5128900:/gv.c

diff --git a/gv.c b/gv.c
index a6b7687..ae76f82 100644
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,6 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -17,42 +17,41 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_GV_C
 #include "perl.h"
 
-EXT char rcsid[];
-
 GV *
-gv_AVadd(register GV *gv)
+Perl_gv_AVadd(pTHX_ register GV *gv)
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
-	croak("Bad symbol for array");
+	Perl_croak(aTHX_ "Bad symbol for array");
     if (!GvAV(gv))
 	GvAV(gv) = newAV();
     return gv;
 }
 
 GV *
-gv_HVadd(register GV *gv)
+Perl_gv_HVadd(pTHX_ register GV *gv)
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
-	croak("Bad symbol for hash");
+	Perl_croak(aTHX_ "Bad symbol for hash");
     if (!GvHV(gv))
 	GvHV(gv) = newHV();
     return gv;
 }
 
 GV *
-gv_IOadd(register GV *gv)
+Perl_gv_IOadd(pTHX_ register GV *gv)
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
-	croak("Bad symbol for filehandle");
+	Perl_croak(aTHX_ "Bad symbol for filehandle");
     if (!GvIOp(gv))
 	GvIOp(gv) = newIO();
     return gv;
 }
 
 GV *
-gv_fetchfile(char *name)
+Perl_gv_fetchfile(pTHX_ const char *name)
 {
     dTHR;
     char smallbuf[256];
@@ -68,9 +67,9 @@ gv_fetchfile(char *name)
     tmpbuf[0] = '_';
     tmpbuf[1] = '<';
     strcpy(tmpbuf + 2, name);
-    gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
+    gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
     if (!isGV(gv))
-	gv_init(gv, defstash, tmpbuf, tmplen, FALSE);
+	gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
     if (tmpbuf != smallbuf)
 	Safefree(tmpbuf);
     sv_setpv(GvSV(gv), name);
@@ -82,7 +81,7 @@ gv_fetchfile(char *name)
 }
 
 void
-gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
+Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
     dTHR;
     register GP *gp;
@@ -101,31 +100,34 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
     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;
+    GvLINE(gv) = PL_curcop->cop_line;
+    GvFILEGV(gv) = PL_curcop->cop_filegv;
+    GvCVGEN(gv) = 0;
     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, '*', name, len);
     GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
-    if (multi)
+    if (multi || doproto)              /* doproto means it _was_ mentioned */
 	GvMULTI_on(gv);
     if (doproto) {			/* Replicate part of newSUB here. */
 	SvIOK_off(gv);
 	ENTER;
+	/* XXX unsafe for threads if eval_owner isn't held */
 	start_subparse(0,0);		/* Create CV in compcv. */
-	GvCV(gv) = compcv;
+	GvCV(gv) = PL_compcv;
 	LEAVE;
 
-	GvCVGEN(gv) = 0;
-	sub_generation++;
+	PL_sub_generation++;
 	CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
-	CvFILEGV(GvCV(gv)) = curcop->cop_filegv;
-	CvSTASH(GvCV(gv)) = curstash;
+	CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv;
+	CvSTASH(GvCV(gv)) = PL_curstash;
 #ifdef USE_THREADS
 	CvOWNER(GvCV(gv)) = 0;
-	New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
-	MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+	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);
@@ -134,8 +136,8 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
     }
 }
 
-static void
-gv_init_sv(GV *gv, I32 sv_type)
+STATIC void
+S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
 {
     switch (sv_type) {
     case SVt_PVIO:
@@ -151,7 +153,7 @@ gv_init_sv(GV *gv, I32 sv_type)
 }
 
 GV *
-gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
+Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 {
     AV* av;
     GV* topgv;
@@ -162,9 +164,10 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
     if (!stash)
 	return 0;
     if ((level > 100) || (level < -100))
-	croak("Recursive inheritance detected");
+	Perl_croak(aTHX_ "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( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
 
     gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
     if (!gvp)
@@ -175,17 +178,19 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 	    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) == PL_sub_generation)
 		return topgv;
 	    /* Stale cached entry: junk it */
 	    SvREFCNT_dec(cv);
 	    GvCV(topgv) = cv = Nullcv;
 	    GvCVGEN(topgv) = 0;
 	}
+	else if (GvCVGEN(topgv) == PL_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;
+    av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
 
     /* create and re-create @.*::SUPER::ISA on demand */
     if (!av || !SvMAGIC(av)) {
@@ -198,11 +203,11 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 	    packlen -= 7;
 	    basestash = gv_stashpvn(packname, packlen, TRUE);
 	    gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
-	    if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+	    if (gvp && (gv = *gvp) != (GV*)&PL_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));
+		    Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
 		if (SvTYPE(gv) != SVt_PVGV)
 		    gv_init(gv, stash, "ISA", 3, TRUE);
 		SvREFCNT_dec(GvAV(gv));
@@ -219,8 +224,9 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 	    SV* sv = *svp++;
 	    HV* basestash = gv_stashsv(sv, FALSE);
 	    if (!basestash) {
-		if (dowarn)
-		    warn("Can't locate package %s for @%s::ISA",
+		dTHR;		/* just for ckWARN */
+		if (ckWARN(WARN_MISC))
+		    Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
 			SvPVX(sv), HvNAME(stash));
 		continue;
 	    }
@@ -253,10 +259,14 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 		    if (cv = GvCV(topgv))
 			SvREFCNT_dec(cv);
 		    GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
-		    GvCVGEN(topgv) = sub_generation;
+		    GvCVGEN(topgv) = PL_sub_generation;
 		}
 		return gv;
 	    }
+	    else if (topgv && GvREFCNT(topgv) == 1) {
+		/* cache the fact that the method is not defined */
+		GvCVGEN(topgv) = PL_sub_generation;
+	    }
 	}
     }
 
@@ -264,17 +274,17 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
 }
 
 GV *
-gv_fetchmethod(HV *stash, char *name)
+Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 {
     return gv_fetchmethod_autoload(stash, name, TRUE);
 }
 
 GV *
-gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
+Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
     dTHR;
-    register char *nend;
-    char *nsplit = 0;
+    register const char *nend;
+    const char *nsplit = 0;
     GV* gv;
     
     for (nend = name; *nend; nend++) {
@@ -284,16 +294,16 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
 	    nsplit = ++nend;
     }
     if (nsplit) {
-	char *origname = name;
+	const char *origname = name;
 	name = nsplit + 1;
 	if (*nsplit == ':')
 	    --nsplit;
 	if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
 	    /* ->SUPER::method should really be looked up in original stash */
-	    SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER",
-					     HvNAME(curcop->cop_stash)));
+	    SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
+					     HvNAME(PL_curcop->cop_stash)));
 	    stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
-	    DEBUG_o( deb("Treating %s as %s::%s\n",
+	    DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
 			 origname, HvNAME(stash), name) );
 	}
 	else
@@ -303,7 +313,7 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
     gv = gv_fetchmeth(stash, name, nend - name, 0);
     if (!gv) {
 	if (strEQ(name,"import"))
-	    gv = (GV*)&sv_yes;
+	    gv = (GV*)&PL_sv_yes;
 	else if (autoload)
 	    gv = gv_autoload4(stash, name, nend - name, TRUE);
     }
@@ -331,8 +341,9 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
 }
 
 GV*
-gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
+Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 {
+    dTHR;
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;
     GV* gv;
@@ -350,8 +361,9 @@ gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
     /*
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
-    if (dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
-	warn(
+    if (ckWARN(WARN_DEPRECATED) && !method && 
+	(GvCVGEN(gv) || GvSTASH(gv) != stash))
+	Perl_warner(aTHX_ WARN_DEPRECATED,
 	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
 	     HvNAME(stash), (int)len, name);
 
@@ -374,13 +386,13 @@ gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
 }
 
 HV*
-gv_stashpv(char *name, I32 create)
+Perl_gv_stashpv(pTHX_ const char *name, I32 create)
 {
     return gv_stashpvn(name, strlen(name), create);
 }
 
 HV*
-gv_stashpvn(char *name, U32 namelen, I32 create)
+Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
 {
     char smallbuf[256];
     char *tmpbuf;
@@ -409,7 +421,7 @@ gv_stashpvn(char *name, U32 namelen, I32 create)
 }
 
 HV*
-gv_stashsv(SV *sv, I32 create)
+Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
 {
     register char *ptr;
     STRLEN len;
@@ -419,14 +431,14 @@ gv_stashsv(SV *sv, I32 create)
 
 
 GV *
-gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
+Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 {
     dTHR;
-    register char *name = nambeg;
+    register const char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;
     I32 len;
-    register char *namend;
+    register const char *namend;
     HV *stash = 0;
     U32 add_gvflags = 0;
 
@@ -438,7 +450,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	    (*namend == ':' && namend[1] == ':'))
 	{
 	    if (!stash)
-		stash = defstash;
+		stash = PL_defstash;
 	    if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
 		return Nullgv;
 
@@ -457,15 +469,15 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 		tmpbuf[len] = '\0';
 		gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
 		gv = gvp ? *gvp : Nullgv;
-		if (gv && gv != (GV*)&sv_undef) {
+		if (gv && gv != (GV*)&PL_sv_undef) {
 		    if (SvTYPE(gv) != SVt_PVGV)
-			gv_init(gv, stash, tmpbuf, len, (add & 2));
+			gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
 		    else
 			GvMULTI_on(gv);
 		}
 		if (tmpbuf != smallbuf)
 		    Safefree(tmpbuf);
-		if (!gv || gv == (GV*)&sv_undef)
+		if (!gv || gv == (GV*)&PL_sv_undef)
 		    return Nullgv;
 
 		if (!(stash = GvHV(gv)))
@@ -480,7 +492,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	    namend++;
 	    name = namend;
 	    if (!*name)
-		return gv ? gv : (GV*)*hv_fetch(defstash, "main::", 6, TRUE);
+		return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
 	}
     }
     len = namend - name;
@@ -490,39 +502,35 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     /* No stash in name, so see how we can default */
 
     if (!stash) {
-	if (isIDFIRST(*name)) {
+	if (isIDFIRST(*name)
+	    || (IN_UTF8 && ((*name & 0xc0) == 0xc0) && isIDFIRST_utf8((U8*)name)))
+	{
 	    bool global = FALSE;
 
 	    if (isUPPER(*name)) {
-		if (*name > 'I') {
-		    if (*name == 'S' && (
-		      strEQ(name, "SIG") ||
-		      strEQ(name, "STDIN") ||
-		      strEQ(name, "STDOUT") ||
-		      strEQ(name, "STDERR") ))
-			global = TRUE;
-		}
-		else if (*name > 'E') {
-		    if (*name == 'I' && strEQ(name, "INC"))
-			global = TRUE;
-		}
-		else if (*name > 'A') {
-		    if (*name == 'E' && strEQ(name, "ENV"))
-			global = TRUE;
-		}
+		if (*name == 'S' && (
+		    strEQ(name, "SIG") ||
+		    strEQ(name, "STDIN") ||
+		    strEQ(name, "STDOUT") ||
+		    strEQ(name, "STDERR")))
+		    global = TRUE;
+		else if (*name == 'I' && strEQ(name, "INC"))
+		    global = TRUE;
+		else if (*name == 'E' && strEQ(name, "ENV"))
+		    global = TRUE;
 		else if (*name == 'A' && (
 		  strEQ(name, "ARGV") ||
-		  strEQ(name, "ARGVOUT") ))
+		  strEQ(name, "ARGVOUT")))
 		    global = TRUE;
 	    }
 	    else if (*name == '_' && !name[1])
 		global = TRUE;
 
 	    if (global)
-		stash = defstash;
-	    else if ((COP*)curcop == &compiling) {
-		stash = curstash;
-		if (add && (hints & HINT_STRICT_VARS) &&
+		stash = PL_defstash;
+	    else if ((COP*)PL_curcop == &PL_compiling) {
+		stash = PL_curstash;
+		if (add && (PL_hints & HINT_STRICT_VARS) &&
 		    sv_type != SVt_PVCV &&
 		    sv_type != SVt_PVGV &&
 		    sv_type != SVt_PVFM &&
@@ -531,7 +539,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 		{
 		    gvp = (GV**)hv_fetch(stash,name,len,0);
 		    if (!gvp ||
-			*gvp == (GV*)&sv_undef ||
+			*gvp == (GV*)&PL_sv_undef ||
 			SvTYPE(*gvp) != SVt_PVGV)
 		    {
 			stash = 0;
@@ -540,21 +548,21 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 			     sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
 			     sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
 		    {
-			warn("Variable \"%c%s\" is not imported",
+			Perl_warn(aTHX_ "Variable \"%c%s\" is not imported",
 			    sv_type == SVt_PVAV ? '@' :
 			    sv_type == SVt_PVHV ? '%' : '$',
 			    name);
 			if (GvCVu(*gvp))
-			    warn("(Did you mean &%s instead?)\n", name);
+			    Perl_warn(aTHX_ "(Did you mean &%s instead?)\n", name);
 			stash = 0;
 		    }
 		}
 	    }
 	    else
-		stash = curcop->cop_stash;
+		stash = PL_curcop->cop_stash;
 	}
 	else
-	    stash = defstash;
+	    stash = PL_defstash;
     }
 
     /* By this point we should have a stash and a name */
@@ -562,20 +570,20 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     if (!stash) {
 	if (!add)
 	    return Nullgv;
-	if (add & ~2) {
+	{
 	    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",
+		Perl_warn(aTHX_ "Global symbol \"%c%s\" requires explicit package name",
 		     sv_type_char, name);
 	    else
-		warn("Global symbol \"%s\" requires explicit package name",
+		Perl_warn(aTHX_ "Global symbol \"%s\" requires explicit package name",
 		     name);
 	}
-	++error_count;
-	stash = curstash ? curstash : defstash;	/* avoid core dumps */
+	++PL_error_count;
+	stash = PL_curstash ? PL_curstash : PL_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
@@ -586,7 +594,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	return Nullgv;
 
     gvp = (GV**)hv_fetch(stash,name,len,add);
-    if (!gvp || *gvp == (GV*)&sv_undef)
+    if (!gvp || *gvp == (GV*)&PL_sv_undef)
 	return Nullgv;
     gv = *gvp;
     if (SvTYPE(gv) == SVt_PVGV) {
@@ -601,12 +609,15 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 
     /* Adding a new symbol */
 
-    if (add & GV_ADDWARN)
-	warn("Had to create %s unexpectedly", nambeg);
+    if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
+	Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg);
     gv_init(gv, stash, name, len, add & GV_ADDMULTI);
     gv_init_sv(gv, sv_type);
     GvFLAGS(gv) |= add_gvflags;
 
+    if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE))
+        GvMULTI_on(gv) ;
+
     /* set up magic where warranted */
     switch (*name) {
     case 'A':
@@ -614,12 +625,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
 	}
 	break;
-
-    case 'a':
-    case 'b':
-	if (len == 1)
-	    GvMULTI_on(gv);
-	break;
     case 'E':
 	if (strnEQ(name, "EXPORT", 6))
 	    GvMULTI_on(gv);
@@ -634,20 +639,19 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 		&& AvFILLp(av) == -1)
 	    {
 		char *pname;
-		av_push(av, newSVpv(pname = "NDBM_File",0));
+		av_push(av, newSVpvn(pname = "NDBM_File",9));
 		gv_stashpvn(pname, 9, TRUE);
-		av_push(av, newSVpv(pname = "DB_File",0));
+		av_push(av, newSVpvn(pname = "DB_File",7));
 		gv_stashpvn(pname, 7, TRUE);
-		av_push(av, newSVpv(pname = "GDBM_File",0));
+		av_push(av, newSVpvn(pname = "GDBM_File",9));
 		gv_stashpvn(pname, 9, TRUE);
-		av_push(av, newSVpv(pname = "SDBM_File",0));
+		av_push(av, newSVpvn(pname = "SDBM_File",9));
 		gv_stashpvn(pname, 9, TRUE);
-		av_push(av, newSVpv(pname = "ODBM_File",0));
+		av_push(av, newSVpvn(pname = "ODBM_File",9));
 		gv_stashpvn(pname, 9, TRUE);
 	    }
 	}
 	break;
-#ifdef OVERLOAD
     case 'O':
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
@@ -655,87 +659,97 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
             hv_magic(hv, gv, 'A');
         }
         break;
-#endif /* OVERLOAD */
     case 'S':
 	if (strEQ(name, "SIG")) {
 	    HV *hv;
 	    I32 i;
-	    siggv = gv;
-	    GvMULTI_on(siggv);
-	    hv = GvHVn(siggv);
-	    hv_magic(hv, siggv, 'S');
-	    for(i=1;sig_name[i];i++) {
+	    PL_siggv = gv;
+	    GvMULTI_on(PL_siggv);
+	    hv = GvHVn(PL_siggv);
+	    hv_magic(hv, PL_siggv, 'S');
+	    for(i=1;PL_sig_name[i];i++) {
 	    	SV ** init;
-	    	init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1);
+	    	init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1);
 	    	if(init)
-	    		sv_setsv(*init,&sv_undef);
-	    	psig_ptr[i] = 0;
-	    	psig_name[i] = 0;
+	    		sv_setsv(*init,&PL_sv_undef);
+	    	PL_psig_ptr[i] = 0;
+	    	PL_psig_name[i] = 0;
 	    }
 	}
 	break;
+    case 'V':
+	if (strEQ(name, "VERSION"))
+	    GvMULTI_on(gv);
+	break;
 
     case '&':
 	if (len > 1)
 	    break;
-	ampergv = gv;
-	sawampersand = TRUE;
+	PL_ampergv = gv;
+	PL_sawampersand = TRUE;
 	goto ro_magicalize;
 
     case '`':
 	if (len > 1)
 	    break;
-	leftgv = gv;
-	sawampersand = TRUE;
+	PL_leftgv = gv;
+	PL_sawampersand = TRUE;
 	goto ro_magicalize;
 
     case '\'':
 	if (len > 1)
 	    break;
-	rightgv = gv;
-	sawampersand = TRUE;
+	PL_rightgv = gv;
+	PL_sawampersand = TRUE;
 	goto ro_magicalize;
 
     case ':':
 	if (len > 1)
 	    break;
-	sv_setpv(GvSV(gv),chopset);
+	sv_setpv(GvSV(gv),PL_chopset);
 	goto magicalize;
 
     case '?':
 	if (len > 1)
 	    break;
 #ifdef COMPLEX_STATUS
-	sv_upgrade(GvSV(gv), SVt_PVLV);
+	(void)SvUPGRADE(GvSV(gv), SVt_PVLV);
 #endif
 	goto magicalize;
 
     case '!':
-	if(len > 1)
+	if (len > 1)
 	    break;
-	if(sv_type > SVt_PV) {
+	if (sv_type > SVt_PV && PL_curcop != &PL_compiling) {
 	    HV* stash = gv_stashpvn("Errno",5,FALSE);
-	    if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+	    if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
 		dSP;
 		PUTBACK;
-		perl_require_pv("Errno.pm");
+		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");
+		    Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
 	    }
 	}
 	goto magicalize;
+    case '-':
+	if (len > 1)
+	    break;
+	else {
+            AV* av = GvAVn(gv);
+            sv_magic((SV*)av, Nullsv, 'D', Nullch, 0);
+        }
+	goto magicalize;
     case '#':
     case '*':
-	if (dowarn && len == 1 && sv_type == SVt_PV)
-	    warn("Use of $%s is deprecated", name);
+	if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV)
+	    Perl_warner(aTHX_ WARN_DEPRECATED, "Use of $%s is deprecated", name);
 	/* FALL THROUGH */
     case '[':
     case '^':
     case '~':
     case '=':
-    case '-':
     case '%':
     case '.':
     case '(':
@@ -747,20 +761,35 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '/':
     case '|':
     case '\001':
+    case '\003':
     case '\004':
     case '\005':
     case '\006':
     case '\010':
+    case '\011':	/* NOT \t in EBCDIC */
     case '\017':
-    case '\t':
     case '\020':
     case '\024':
-    case '\027':
 	if (len > 1)
 	    break;
 	goto magicalize;
+    case '\023':
+	if (len > 1)
+	    break;
+	goto ro_magicalize;
+    case '\027':	/* $^W & $^Warnings */
+	if (len > 1 && strNE(name, "\027arnings"))
+	    break;
+	goto magicalize;
 
     case '+':
+	if (len > 1)
+	    break;
+	else {
+            AV* av = GvAVn(gv);
+            sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0);
+        }
+	/* FALL THROUGH */
     case '1':
     case '2':
     case '3':
@@ -770,7 +799,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '7':
     case '8':
     case '9':
-    case '\023':
       ro_magicalize:
 	SvREADONLY_on(GvSV(gv));
       magicalize:
@@ -781,7 +809,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	if (len > 1)
 	    break;
 	sv_setpv(GvSV(gv),"\f");
-	formfeed = GvSV(gv);
+	PL_formfeed = GvSV(gv);
 	break;
     case ';':
 	if (len > 1)
@@ -791,8 +819,8 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case ']':
 	if (len == 1) {
 	    SV *sv = GvSV(gv);
-	    sv_upgrade(sv, SVt_PVNV);
-	    sv_setpv(sv, patchlevel);
+	    (void)SvUPGRADE(sv, SVt_PVNV);
+	    sv_setpv(sv, PL_patchlevel);
 	    (void)sv_2nv(sv);
 	    SvREADONLY_on(sv);
 	}
@@ -802,7 +830,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 }
 
 void
-gv_fullname3(SV *sv, GV *gv, char *prefix)
+Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
 {
     HV *hv = GvSTASH(gv);
     if (!hv) {
@@ -816,7 +844,7 @@ gv_fullname3(SV *sv, GV *gv, char *prefix)
 }
 
 void
-gv_efullname3(SV *sv, GV *gv, char *prefix)
+Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
 {
     GV *egv = GvEGV(gv);
     if (!egv)
@@ -826,20 +854,20 @@ gv_efullname3(SV *sv, GV *gv, char *prefix)
 
 /* XXX compatibility with versions <= 5.003. */
 void
-gv_fullname(SV *sv, GV *gv)
+Perl_gv_fullname(pTHX_ SV *sv, GV *gv)
 {
     gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 /* XXX compatibility with versions <= 5.003. */
 void
-gv_efullname(SV *sv, GV *gv)
+Perl_gv_efullname(pTHX_ SV *sv, GV *gv)
 {
     gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
 }
 
 IO *
-newIO(void)
+Perl_newIO(pTHX)
 {
     dTHR;
     IO *io;
@@ -850,14 +878,15 @@ newIO(void)
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
     iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
-    if (!iogv)
+    /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
+    if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
       iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
 
 void
-gv_check(HV *stash)
+Perl_gv_check(pTHX_ HV *stash)
 {
     dTHR;
     register HE *entry;
@@ -873,19 +902,20 @@ gv_check(HV *stash)
 	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
 		(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
 	    {
-		if (hv != defstash)
+		if (hv != PL_defstash && hv != stash)
 		     gv_check(hv);              /* nested package */
 	    }
 	    else if (isALPHA(*HeKEY(entry))) {
 		gv = (GV*)HeVAL(entry);
 		if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
 		    continue;
-		curcop->cop_line = GvLINE(gv);
+		PL_curcop->cop_line = GvLINE(gv);
 		filegv = GvFILEGV(gv);
-		curcop->cop_filegv = filegv;
+		PL_curcop->cop_filegv = filegv;
 		if (filegv && GvMULTI(filegv))	/* Filename began with slash */
 		    continue;
-		warn("Name \"%s::%s\" used only once: possible typo",
+		Perl_warner(aTHX_ WARN_ONCE,
+			"Name \"%s::%s\" used only once: possible typo",
 			HvNAME(stash), GvNAME(gv));
 	    }
 	}
@@ -893,16 +923,16 @@ gv_check(HV *stash)
 }
 
 GV *
-newGVgen(char *pack)
+Perl_newGVgen(pTHX_ char *pack)
 {
-    return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)gensym++),
+    return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
 		      TRUE, SVt_PVGV);
 }
 
 /* hopefully this is only called on local symbol table entries */
 
 GP*
-gp_ref(GP *gp)
+Perl_gp_ref(pTHX_ GP *gp)
 {
     gp->gp_refcnt++;
     if (gp->gp_cv) {
@@ -914,27 +944,30 @@ gp_ref(GP *gp)
 	}
 	else {
 	    /* Adding a new name to a subroutine invalidates method cache */
-	    sub_generation++;
+	    PL_sub_generation++;
 	}
     }
     return gp;
 }
 
 void
-gp_free(GV *gv)
+Perl_gp_free(pTHX_ GV *gv)
 {
+    dTHR;  
     GP* gp;
     CV* cv;
 
     if (!gv || !(gp = GvGP(gv)))
 	return;
     if (gp->gp_refcnt == 0) {
-        warn("Attempt to free unreferenced glob pointers");
+	if (ckWARN_d(WARN_INTERNAL))
+	    Perl_warner(aTHX_ WARN_INTERNAL,
+			"Attempt to free unreferenced glob pointers");
         return;
     }
     if (gp->gp_cv) {
 	/* Deleting the name of a subroutine invalidates method cache */
-	sub_generation++;
+	PL_sub_generation++;
     }
     if (--gp->gp_refcnt > 0) {
 	if (gp->gp_egv == gv)
@@ -977,11 +1010,10 @@ register GV *gv;
 }
 #endif			/* Microport 2.4 hack */
 
-#ifdef OVERLOAD
 /* Updates and caches the CV's */
 
 bool
-Gv_AMupdate(HV *stash)
+Perl_Gv_AMupdate(pTHX_ HV *stash)
 {
   dTHR;  
   GV** gvp;
@@ -991,9 +1023,10 @@ Gv_AMupdate(HV *stash)
   MAGIC* mg=mg_find((SV*)stash,'c');
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
+  STRLEN n_a;
 
-  if (mg && amtp->was_ok_am == amagic_generation
-      && amtp->was_ok_sub == sub_generation)
+  if (mg && amtp->was_ok_am == PL_amagic_generation
+      && amtp->was_ok_sub == PL_sub_generation)
       return AMT_AMAGIC(amtp);
   if (amtp && AMT_AMAGIC(amtp)) {	/* Have table. */
     int i;
@@ -1005,40 +1038,40 @@ Gv_AMupdate(HV *stash)
   }
   sv_unmagic((SV*)stash, 'c');
 
-  DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
+  DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
 
-  amt.was_ok_am = amagic_generation;
-  amt.was_ok_sub = sub_generation;
+  amt.was_ok_am = PL_amagic_generation;
+  amt.was_ok_sub = PL_sub_generation;
   amt.fallback = AMGfallNO;
   amt.flags = 0;
 
 #ifdef OVERLOAD_VIA_HASH
   gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE);	/* A shortcut */
-  if (gvp && ((gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv)))) {
+  if (gvp && ((gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv)))) {
     int filled=0;
     int i;
     char *cp;
     SV* sv;
     SV** svp;
 
-    /* Work with "fallback" key, which we assume to be first in AMG_names */
+    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
-    if (( cp = (char *)AMG_names[0] ) &&
+    if (( cp = (char *)PL_AMG_names[0] ) &&
 	(svp = (SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) {
       if (SvTRUE(sv)) amt.fallback=AMGfallYES;
       else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
     }
     for (i = 1; i < NofAMmeth; i++) {
       cv = 0;
-      cp = (char *)AMG_names[i];
+      cp = (char *)PL_AMG_names[i];
       
         svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
-        if (svp && ((sv = *svp) != &sv_undef)) {
+        if (svp && ((sv = *svp) != &PL_sv_undef)) {
           switch (SvTYPE(sv)) {
             default:
               if (!SvROK(sv)) {
                 if (!SvOK(sv)) break;
-		gv = gv_fetchmethod(stash, SvPV(sv, na));
+		gv = gv_fetchmethod(stash, SvPV(sv, n_a));
                 if (gv) cv = GvCV(gv);
                 break;
               }
@@ -1048,19 +1081,19 @@ Gv_AMupdate(HV *stash)
                 /* FALL THROUGH */
             case SVt_PVHV:
             case SVt_PVAV:
-	      croak("Not a subroutine reference in overload table");
+	      Perl_croak(aTHX_ "Not a subroutine reference in overload table");
 	      return FALSE;
             case SVt_PVCV:
               cv = (CV*)sv;
               break;
             case SVt_PVGV:
               if (!(cv = GvCVu((GV*)sv)))
-                cv = sv_2cv(sv, &stash, &gv, TRUE);
+                cv = sv_2cv(sv, &stash, &gv, FALSE);
               break;
           }
           if (cv) filled=1;
 	  else {
-	    croak("Method for operation %s not found in package %.256s during blessing\n",
+	    Perl_croak(aTHX_ "Method for operation %s not found in package %.256s during blessing\n",
 		cp,HvNAME(stash));
 	    return FALSE;
 	  }
@@ -1073,9 +1106,9 @@ Gv_AMupdate(HV *stash)
     SV* sv = NULL;
     SV** svp;
 
-    /* Work with "fallback" key, which we assume to be first in AMG_names */
+    /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
-    if ( cp = AMG_names[0] ) {
+    if ( cp = PL_AMG_names[0] ) {
 	/* Try to find via inheritance. */
 	gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
 	if (gv) sv = GvSV(gv);
@@ -1086,8 +1119,8 @@ Gv_AMupdate(HV *stash)
     }
 
     for (i = 1; i < NofAMmeth; i++) {
-	SV *cookie = sv_2mortal(newSVpvf("(%s", cp = AMG_names[i]));
-	DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
+	SV *cookie = sv_2mortal(Perl_newSVpvf(aTHX_ "(%s", cp = PL_AMG_names[i]));
+	DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
 		     cp, HvNAME(stash)) );
 	/* don't fill the cache while looking up! */
 	gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1);
@@ -1098,25 +1131,25 @@ Gv_AMupdate(HV *stash)
 		/* GvSV contains the name of the method. */
 		GV *ngv;
 		
-		DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
-			     SvPV(GvSV(gv), na), cp, HvNAME(stash)) );
+		DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
+			     SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
 		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'", 
+			Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", 
 			      (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
 			      cp, HvNAME(stash));
 		    } else
-			croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'", 
+			Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'", 
 			      (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
 			      cp, HvNAME(stash));
 		}
 		cv = GvCV(gv = ngv);
 	    }
-	    DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
+	    DEBUG_o( Perl_deb(aTHX_ "Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
 			 cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
 			 GvNAME(CvGV(cv))) );
 	    filled = 1;
@@ -1138,7 +1171,7 @@ Gv_AMupdate(HV *stash)
 }
 
 SV*
-amagic_call(SV *left, SV *right, int method, int flags)
+Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
   dTHR;
   MAGIC *mg; 
@@ -1146,7 +1179,7 @@ amagic_call(SV *left, SV *right, int method, int flags)
   CV **cvp=NULL, **ocvp=NULL;
   AMT *amtp, *oamtp;
   int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
-  int postpr=0, inc_dec_ass=0, assignshift=assign?1:0;
+  int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
   HV* stash;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
@@ -1163,17 +1196,20 @@ amagic_call(SV *left, SV *right, int method, int flags)
       int logic;
 
       /* look for substituted methods */
+      /* In all the covered cases we should be called with assign==0. */
 	 switch (method) {
 	 case inc_amg:
-	   if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1))
-	       || ((cv = cvp[off=add_amg]) && (postpr=1))) {
-	     right = &sv_yes; lr = -1; assign = 1;
+	   force_cpy = 1;
+	   if ((cv = cvp[off=add_ass_amg])
+	       || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) {
+	     right = &PL_sv_yes; lr = -1; assign = 1;
 	   }
 	   break;
 	 case dec_amg:
-	   if (((cv = cvp[off=subtr_ass_amg])  && (inc_dec_ass=1))
-	       || ((cv = cvp[off=subtr_amg]) && (postpr=1))) {
-	     right = &sv_yes; lr = -1; assign = 1;
+	   force_cpy = 1;
+	   if ((cv = cvp[off = subtr_ass_amg])
+	       || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) {
+	     right = &PL_sv_yes; lr = -1; assign = 1;
 	   }
 	   break;
 	 case bool__amg:
@@ -1193,15 +1229,19 @@ amagic_call(SV *left, SV *right, int method, int flags)
    break;
 	 case copy_amg:
 	   {
-	     SV* ref=SvRV(left);
-	     if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) {
+	     /*
+		  * 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(ref);
+		SV* newref = newSVsv(tmpRef);
 		SvOBJECT_on(newref);
-		SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+		SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
 		return newref;
 	     }
 	   }
@@ -1237,6 +1277,15 @@ amagic_call(SV *left, SV *right, int method, int flags)
 	     lr = 1;
 	   }
 	   break;
+	 case iter_amg:			/* XXXX Eventually should do to_gv. */
+	 case to_sv_amg:
+	 case to_av_amg:
+	 case to_hv_amg:
+	 case to_gv_amg:
+	 case to_cv_amg:
+	     /* FAIL safe */
+	     return NULL;	/* Delegate operation to standard mechanisms. */
+	     break;
 	 default:
 	   goto not_found;
 	 }
@@ -1290,9 +1339,9 @@ amagic_call(SV *left, SV *right, int method, int flags)
       } else {
 	SV *msg;
 	if (off==-1) off=method;
-	msg = sv_2mortal(newSVpvf(
+	msg = sv_2mortal(Perl_newSVpvf(aTHX_ 
 		      "Operation `%s': no method found,%sargument %s%s%s%s",
-		      AMG_names[method + assignshift],
+		      PL_AMG_names[method + assignshift],
 		      (flags & AMGf_unary ? " " : "\n\tleft "),
 		      SvAMAGIC(left)? 
 		        "in overloaded package ":
@@ -1309,36 +1358,56 @@ amagic_call(SV *left, SV *right, int method, int flags)
 		        HvNAME(SvSTASH(SvRV(right))):
 		        ""));
 	if (amtp && amtp->fallback >= AMGfallYES) {
-	  DEBUG_o( deb("%s", SvPVX(msg)) );
+	  DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX(msg)) );
 	} else {
-	  croak("%_", msg);
+	  Perl_croak(aTHX_ "%_", msg);
 	}
 	return NULL;
       }
+      force_cpy = force_cpy || assign;
     }
   }
   if (!notfound) {
-    DEBUG_o( deb(
+    DEBUG_o( Perl_deb(aTHX_ 
   "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
-		 AMG_names[off],
+		 PL_AMG_names[off],
 		 method+assignshift==off? "" :
 		             " (initially `",
 		 method+assignshift==off? "" :
-		             AMG_names[method+assignshift],
+		             PL_AMG_names[method+assignshift],
 		 method+assignshift==off? "" : "')",
 		 flags & AMGf_unary? "" :
 		   lr==1 ? " for right argument": " for left argument",
 		 flags & AMGf_unary? " for argument" : "",
 		 HvNAME(stash), 
 		 fl? ",\n\tassignment variant used": "") );
+  }
     /* Since we use shallow copy during assignment, we need
      * to dublicate the contents, probably calling user-supplied
      * version of copy operator
      */
-    if ((method + assignshift==off 
-	 && (assign || method==inc_amg || method==dec_amg))
-	|| inc_dec_ass) RvDEEPCP(left);
-  }
+    /* We need to copy in following cases:
+     * a) Assignment form was called.
+     * 		assignshift==1,  assign==T, method + 1 == off
+     * b) Increment or decrement, called directly.
+     * 		assignshift==0,  assign==0, method + 0 == off
+     * c) Increment or decrement, translated to assignment add/subtr.
+     * 		assignshift==0,  assign==T, 
+     *		force_cpy == T
+     * d) Increment or decrement, translated to nomethod.
+     * 		assignshift==0,  assign==0, 
+     *		force_cpy == T
+     * e) Assignment form translated to nomethod.
+     * 		assignshift==1,  assign==T, method + 1 != off
+     *		force_cpy == T
+     */
+    /*	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)
+	&& (assign || (method == inc_amg) || (method == dec_amg)))
+      || force_cpy)
+    RvDEEPCP(left);
   {
     dSP;
     BINOP myop;
@@ -1351,32 +1420,33 @@ amagic_call(SV *left, SV *right, int method, int flags)
     myop.op_next = Nullop;
     myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
 
-    PUSHSTACK(SI_OVERLOAD);
+    PUSHSTACKi(PERLSI_OVERLOAD);
     ENTER;
     SAVEOP();
-    op = (OP *) &myop;
-    if (PERLDB_SUB && curstash != debstash)
-	op->op_private |= OPpENTERSUB_DB;
+    PL_op = (OP *) &myop;
+    if (PERLDB_SUB && PL_curstash != PL_debstash)
+	PL_op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
-    pp_pushmark(ARGS);
+    pp_pushmark();
 
     EXTEND(SP, notfound + 5);
     PUSHs(lr>0? right: left);
     PUSHs(lr>0? left: right);
-    PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no ));
+    PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
     if (notfound) {
-      PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) );
+      PUSHs( sv_2mortal(newSVpv((char *)PL_AMG_names[method + assignshift],0)));
     }
     PUSHs((SV*)cv);
     PUTBACK;
 
-    if (op = pp_entersub(ARGS))
-      runops();
+    if (PL_op = Perl_pp_entersub(aTHX))
+      CALLRUNOPS(aTHX);
     LEAVE;
     SPAGAIN;
 
     res=POPs;
-    POPSTACK();
+    PUTBACK;
+    POPSTACK;
     CATCH_SET(oldcatch);
 
     if (postpr) {
@@ -1404,12 +1474,12 @@ amagic_call(SV *left, SV *right, int method, int flags)
       case dec_amg:
 	SvSetSV(left,res); return left;
       case not_amg:
-	ans=!SvOK(res); break;
+	ans=!SvTRUE(res); break;
       }
       return boolSV(ans);
     } else if (method==copy_amg) {
       if (!SvROK(res)) {
-	croak("Copy method did not return a reference");
+	Perl_croak(aTHX_ "Copy method did not return a reference");
       }
       return SvREFCNT_inc(SvRV(res));
     } else {
@@ -1417,5 +1487,3 @@ amagic_call(SV *left, SV *right, int method, int flags)
     }
   }
 }
-#endif /* OVERLOAD */
-