X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=00386806f4010850c8b78a39b5231865576819d9;hb=7377d752f328690fcb4417d17046f5d18d3582d6;hp=88646a2f0b43d46ba7384297677106ca663dbed4;hpb=5b794e0558240996f259d9acbc8089c989bf711e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 88646a2..0038680 100644
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, 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.
@@ -15,6 +15,7 @@
  * either way, as the saying is, if you follow me."  --the Gaffer
  */
 
+
 #include "EXTERN.h"
 #define PERL_IN_OP_C
 #include "perl.h"
@@ -22,28 +23,79 @@
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
 
-/* #define PL_OP_SLAB_ALLOC */
+#if defined(PL_OP_SLAB_ALLOC)
 
-#ifdef PL_OP_SLAB_ALLOC
-#define SLAB_SIZE 8192
-static char    *PL_OpPtr  = NULL;
-static int     PL_OpSpace = 0;
-#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0)     \
-                              var =  (type *)(PL_OpPtr -= c*sizeof(type));    \
-                             else                                             \
-                              var = (type *) Slab_Alloc(m,c*sizeof(type));    \
-                           } while (0)
+#ifndef PERL_SLAB_SIZE
+#define PERL_SLAB_SIZE 2048
+#endif
+
+#define NewOp(m,var,c,type) \
+	STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
+
+#define FreeOp(p) Slab_Free(p)
 
 STATIC void *
 S_Slab_Alloc(pTHX_ int m, size_t sz)
 {
- Newz(m,PL_OpPtr,SLAB_SIZE,char);
- PL_OpSpace = SLAB_SIZE - sz;
- return PL_OpPtr += PL_OpSpace;
+    /*
+     * To make incrementing use count easy PL_OpSlab is an I32 *
+     * To make inserting the link to slab PL_OpPtr is I32 **
+     * So compute size in units of sizeof(I32 *) as that is how Pl_OpPtr increments
+     * Add an overhead for pointer to slab and round up as a number of pointers
+     */
+    sz = (sz + 2*sizeof(I32 *) -1)/sizeof(I32 *);
+    if ((PL_OpSpace -= sz) < 0) {
+        PL_OpPtr = (I32 **) PerlMemShared_malloc(PERL_SLAB_SIZE*sizeof(I32*)); 
+    	if (!PL_OpPtr) {
+	    return NULL;
+	}
+	Zero(PL_OpPtr,PERL_SLAB_SIZE,I32 **);
+	/* We reserve the 0'th I32 sized chunk as a use count */
+	PL_OpSlab = (I32 *) PL_OpPtr;
+	/* Reduce size by the use count word, and by the size we need.
+	 * Latter is to mimic the '-=' in the if() above
+	 */
+	PL_OpSpace = PERL_SLAB_SIZE - (sizeof(I32)+sizeof(I32 **)-1)/sizeof(I32 **) - sz;
+	/* Allocation pointer starts at the top.
+	   Theory: because we build leaves before trunk allocating at end
+	   means that at run time access is cache friendly upward
+	 */
+	PL_OpPtr += PERL_SLAB_SIZE;
+    }
+    assert( PL_OpSpace >= 0 );
+    /* Move the allocation pointer down */
+    PL_OpPtr   -= sz;
+    assert( PL_OpPtr > (I32 **) PL_OpSlab );
+    *PL_OpPtr   = PL_OpSlab;	/* Note which slab it belongs to */
+    (*PL_OpSlab)++;		/* Increment use count of slab */
+    assert( PL_OpPtr+sz <= ((I32 **) PL_OpSlab + PERL_SLAB_SIZE) );
+    assert( *PL_OpSlab > 0 );
+    return (void *)(PL_OpPtr + 1);
+}
+
+STATIC void
+S_Slab_Free(pTHX_ void *op)
+{
+    I32 **ptr = (I32 **) op;
+    I32 *slab = ptr[-1];
+    assert( ptr-1 > (I32 **) slab );
+    assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
+    assert( *slab > 0 );
+    if (--(*slab) == 0) {
+     #ifdef NETWARE
+      #define PerlMemShared PerlMem
+     #endif
+	
+    PerlMemShared_free(slab);
+	if (slab == PL_OpSlab) {
+	    PL_OpSpace = 0;
+	}
+    }
 }
 
 #else
 #define NewOp(m, var, c, type) Newz(m, var, c, type)
+#define FreeOp(p) Safefree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -143,7 +195,7 @@ Perl_pad_allocmy(pTHX_ char *name)
 	SV **svp = AvARRAY(PL_comppad_name);
 	HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
 	PADOFFSET top = AvFILLp(PL_comppad_name);
-	for (off = top; off > PL_comppad_name_floor; off--) {
+	for (off = top; (I32)off > PL_comppad_name_floor; off--) {
 	    if ((sv = svp[off])
 		&& sv != &PL_sv_undef
 		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
@@ -151,7 +203,7 @@ Perl_pad_allocmy(pTHX_ char *name)
 		    || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
 		&& strEQ(name, SvPVX(sv)))
 	    {
-		Perl_warner(aTHX_ WARN_MISC,
+		Perl_warner(aTHX_ packWARN(WARN_MISC),
 		    "\"%s\" variable %s masks earlier declaration in same %s",
 		    (PL_in_my == KEY_our ? "our" : "my"),
 		    name,
@@ -168,9 +220,9 @@ Perl_pad_allocmy(pTHX_ char *name)
 		    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
 		    && strEQ(name, SvPVX(sv)))
 		{
-		    Perl_warner(aTHX_ WARN_MISC,
+		    Perl_warner(aTHX_ packWARN(WARN_MISC),
 			"\"our\" variable %s redeclared", name);
-		    Perl_warner(aTHX_ WARN_MISC,
+		    Perl_warner(aTHX_ packWARN(WARN_MISC),
 			"\t(Did you mean \"local\" instead of \"our\"?)\n");
 		    break;
 		}
@@ -256,8 +308,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 	for (off = AvFILLp(curname); off > 0; off--) {
 	    if ((sv = svp[off]) &&
 		sv != &PL_sv_undef &&
-		seq <= SvIVX(sv) &&
-		seq > I_32(SvNVX(sv)) &&
+		seq <= (U32)SvIVX(sv) &&
+		seq > (U32)I_32(SvNVX(sv)) &&
 		strEQ(SvPVX(sv), name))
 	    {
 		I32 depth;
@@ -311,7 +363,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 				    if (ckWARN(WARN_CLOSURE)
 					&& !CvUNIQUE(bcv) && !CvUNIQUE(cv))
 				    {
-					Perl_warner(aTHX_ WARN_CLOSURE,
+					Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
 					  "Variable \"%s\" may be unavailable",
 					     name);
 				    }
@@ -324,7 +376,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 			if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
 			    && !(SvFLAGS(sv) & SVpad_OUR))
 			{
-			    Perl_warner(aTHX_ WARN_CLOSURE,
+			    Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
 				"Variable \"%s\" will not stay shared", name);
 			}
 		    }
@@ -419,8 +471,8 @@ Perl_pad_findmy(pTHX_ char *name)
 	if ((sv = svp[off]) &&
 	    sv != &PL_sv_undef &&
 	    (!SvIVX(sv) ||
-	     (seq <= SvIVX(sv) &&
-	      seq > I_32(SvNVX(sv)))) &&
+	     (seq <= (U32)SvIVX(sv) &&
+	      seq > (U32)I_32(SvNVX(sv)))) &&
 	    strEQ(SvPVX(sv), name))
 	{
 	    if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
@@ -461,7 +513,7 @@ Perl_pad_leavemy(pTHX_ I32 fill)
     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
 	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
 	    if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
-		Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv));
+		Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%s never introduced", SvPVX(sv));
 	}
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -726,7 +778,7 @@ Perl_op_free(pTHX_ OP *o)
     }
     type = o->op_type;
     if (type == OP_NULL)
-	type = o->op_targ;
+	type = (OPCODE)o->op_targ;
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
@@ -734,14 +786,7 @@ Perl_op_free(pTHX_ OP *o)
 	cop_free((COP*)o);
 
     op_clear(o);
-
-#ifdef PL_OP_SLAB_ALLOC
-    if ((char *) o == PL_OpPtr)
-     {
-     }
-#else
-    Safefree(o);
-#endif
+    FreeOp(o);
 }
 
 void
@@ -813,10 +858,10 @@ Perl_op_clear(pTHX_ OP *o)
 	goto clear_pmop;
     case OP_PUSHRE:
 #ifdef USE_ITHREADS
-	if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+        if (INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)) {
 	    if (PL_curpad) {
-		GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
-		pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+		GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)];
+		pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot));
 		/* No GvIN_PAD_off(gv) here, because other references may still
 		 * exist on the pad */
 		SvREFCNT_dec(gv);
@@ -846,11 +891,7 @@ clear_pmop:
 		    pmop = pmop->op_pmnext;
 		}
 	    }
-#ifdef USE_ITHREADS
-	    Safefree(PmopSTASHPV(cPMOPo));
-#else
-	    /* NOTE: PMOP.op_pmstash is not refcounted */
-#endif
+	    PmopSTASH_free(cPMOPo);
 	}
 	cPMOPo->op_pmreplroot = Nullop;
         /* we use the "SAFE" version of the PM_ macros here
@@ -867,7 +908,7 @@ clear_pmop:
 	    SvREPADTMP_on(PL_regex_pad[(cPMOPo)->op_pmoffset]);
             PM_SETRE(cPMOPo, (cPMOPo)->op_pmoffset);
         }
-#endif 
+#endif
 
 	break;
     }
@@ -881,18 +922,22 @@ clear_pmop:
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
-    Safefree(cop->cop_label);
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(cop));		/* XXX share in a pvtable? */
-    Safefree(CopSTASHPV(cop));		/* XXX share in a pvtable? */
-#else
-    /* NOTE: COP.cop_stash is not refcounted */
-    SvREFCNT_dec(CopFILEGV(cop));
-#endif
+    Safefree(cop->cop_label);   /* FIXME: treaddead ??? */
+    CopFILE_free(cop);
+    CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
 	SvREFCNT_dec(cop->cop_warnings);
-    if (! specialCopIO(cop->cop_io))
+    if (! specialCopIO(cop->cop_io)) {
+#ifdef USE_ITHREADS
+#if 0
+	STRLEN len;
+        char *s = SvPV(cop->cop_io,len);
+	Perl_warn(aTHX_ "io='%.*s'",(int) len,s); /* ??? --jhi */
+#endif
+#else
 	SvREFCNT_dec(cop->cop_io);
+#endif
+    }
 }
 
 void
@@ -954,7 +999,7 @@ S_scalarboolean(pTHX_ OP *o)
 
 	    if (PL_copline != NOLINE)
 		CopLINE_set(PL_curcop, PL_copline);
-	    Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
+	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be ==");
 	    CopLINE_set(PL_curcop, oldline);
 	}
     }
@@ -988,7 +1033,7 @@ Perl_scalar(pTHX_ OP *o)
     case OP_SPLIT:
 	if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 	    if (!kPMOP->op_pmreplroot)
-		deprecate("implicit split to @_");
+		deprecate_old("implicit split to @_");
 	}
 	/* FALL THROUGH */
     case OP_MATCH:
@@ -1024,6 +1069,9 @@ Perl_scalar(pTHX_ OP *o)
 	}
 	WITH_THR(PL_curcop = &PL_compiling);
 	break;
+    case OP_SORT:
+	if (ckWARN(WARN_VOID))
+	    Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
     }
     return o;
 }
@@ -1232,12 +1280,12 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_SPLIT:
 	if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 	    if (!kPMOP->op_pmreplroot)
-		deprecate("implicit split to @_");
+		deprecate_old("implicit split to @_");
 	}
 	break;
     }
     if (useless && ckWARN(WARN_VOID))
-	Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
+	Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
     return o;
 }
 
@@ -1413,6 +1461,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
 	    break;
 	}
+	else if (o->op_private & OPpENTERSUB_NOMOD)
+	    return o;
 	else {				/* lvalue subroutine call */
 	    o->op_private |= OPpLVAL_INTRO;
 	    PL_modcount = RETURN_UNLIMITED_NUMBER;
@@ -1431,8 +1481,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
 		    Perl_croak(aTHX_
 			       "panic: unexpected lvalue entersub "
-			       "args: type/targ %ld:%ld",
-			       (long)kid->op_type,kid->op_targ);
+			       "args: type/targ %ld:%"UVuf,
+			       (long)kid->op_type, (UV)kid->op_targ);
 		kid = kLISTOP->op_first;
 	      skip_kids:
 		while (kid->op_sibling)
@@ -1444,11 +1494,6 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    {
 			UNOP *newop;
 
-			if (kid->op_sibling || kid->op_next != kid) {
-			    yyerror("panic: unexpected optree near method call");
-			    break;
-			}
-			
 			NewOp(1101, newop, 1, UNOP);
 			newop->op_type = OP_RV2CV;
 			newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
@@ -1458,25 +1503,25 @@ Perl_mod(pTHX_ OP *o, I32 type)
 			newop->op_private |= OPpLVAL_INTRO;
 			break;
 		    }
-		
+
 		    if (kid->op_type != OP_RV2CV)
 			Perl_croak(aTHX_
 				   "panic: unexpected lvalue entersub "
-				   "entry via type/targ %ld:%ld",
-				   (long)kid->op_type,kid->op_targ);
+				   "entry via type/targ %ld:%"UVuf,
+				   (long)kid->op_type, (UV)kid->op_targ);
 		    kid->op_private |= OPpLVAL_INTRO;
 		    break;	/* Postpone until runtime */
 		}
-		
-		okid = kid;		
+
+		okid = kid;
 		kid = kUNOP->op_first;
 		if (kid->op_type == OP_NULL && kid->op_targ == OP_RV2SV)
 		    kid = kUNOP->op_first;
-		if (kid->op_type == OP_NULL)		
+		if (kid->op_type == OP_NULL)
 		    Perl_croak(aTHX_
 			       "Unexpected constant lvalue entersub "
-			       "entry via type/targ %ld:%ld",
-			       (long)kid->op_type,kid->op_targ);
+			       "entry via type/targ %ld:%"UVuf,
+			       (long)kid->op_type, (UV)kid->op_targ);
 		if (kid->op_type != OP_GV) {
 		    /* Restore RV2CV to check lvalueness */
 		  restore_2cv:
@@ -1492,7 +1537,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    okid->op_private |= OPpLVAL_INTRO;
 		    break;
 		}
-		
+
 		cv = GvCV(kGVOP_gv);
 		if (!cv)
 		    goto restore_2cv;
@@ -1539,7 +1584,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    goto nomod;
 	PL_modcount++;
 	break;
-	
+
     case OP_COND_EXPR:
 	for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 	    mod(kid, type);
@@ -1610,7 +1655,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     case OP_PUSHMARK:
 	break;
-	
+
     case OP_KEYS:
 	if (type != OP_SASSIGN)
 	    goto nomod;
@@ -1670,6 +1715,14 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    goto nomod;
 	break; /* mod()ing was handled by ck_return() */
     }
+
+    /* [20011101.069] File test operators interpret OPf_REF to mean that
+       their argument is a filehandle; thus \stat(".") should not set
+       it. AMS 20011102 */
+    if (type == OP_REFGEN &&
+        PL_check[o->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst))
+        return o;
+
     if (type != OP_LEAVESUBLV)
         o->op_flags |= OPf_MOD;
 
@@ -1880,7 +1933,7 @@ S_dup_attrlist(pTHX_ OP *o)
 }
 
 STATIC void
-S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
+S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 {
     SV *stashsv;
 
@@ -1893,19 +1946,99 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 	stashsv = &PL_sv_no;
 
 #define ATTRSMODULE "attributes"
+#define ATTRSMODULE_PM "attributes.pm"
 
-    Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
-		     newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
-		     Nullsv,
-		     prepend_elem(OP_LIST,
-				  newSVOP(OP_CONST, 0, stashsv),
-				  prepend_elem(OP_LIST,
-					       newSVOP(OP_CONST, 0,
-						       newRV(target)),
-					       dup_attrlist(attrs))));
+    if (for_my) {
+	SV **svp;
+	/* Don't force the C<use> if we don't need it. */
+	svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
+		       sizeof(ATTRSMODULE_PM)-1, 0);
+	if (svp && *svp != &PL_sv_undef)
+	    ; 		/* already in %INC */
+	else
+	    Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+			     newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+			     Nullsv);
+    }
+    else {
+	Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
+			 newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+			 Nullsv,
+			 prepend_elem(OP_LIST,
+				      newSVOP(OP_CONST, 0, stashsv),
+				      prepend_elem(OP_LIST,
+						   newSVOP(OP_CONST, 0,
+							   newRV(target)),
+						   dup_attrlist(attrs))));
+    }
     LEAVE;
 }
 
+STATIC void
+S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
+{
+    OP *pack, *imop, *arg;
+    SV *meth, *stashsv;
+
+    if (!attrs)
+	return;
+
+    assert(target->op_type == OP_PADSV ||
+	   target->op_type == OP_PADHV ||
+	   target->op_type == OP_PADAV);
+
+    /* Ensure that attributes.pm is loaded. */
+    apply_attrs(stash, pad_sv(target->op_targ), attrs, TRUE);
+
+    /* Need package name for method call. */
+    pack = newSVOP(OP_CONST, 0, newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
+
+    /* Build up the real arg-list. */
+    if (stash)
+	stashsv = newSVpv(HvNAME(stash), 0);
+    else
+	stashsv = &PL_sv_no;
+    arg = newOP(OP_PADSV, 0);
+    arg->op_targ = target->op_targ;
+    arg = prepend_elem(OP_LIST,
+		       newSVOP(OP_CONST, 0, stashsv),
+		       prepend_elem(OP_LIST,
+				    newUNOP(OP_REFGEN, 0,
+					    mod(arg, OP_REFGEN)),
+				    dup_attrlist(attrs)));
+
+    /* Fake up a method call to import */
+    meth = newSVpvn("import", 6);
+    (void)SvUPGRADE(meth, SVt_PVIV);
+    (void)SvIOK_on(meth);
+    PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
+    imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
+		   append_elem(OP_LIST,
+			       prepend_elem(OP_LIST, pack, list(arg)),
+			       newSVOP(OP_METHOD_NAMED, 0, meth)));
+    imop->op_private |= OPpENTERSUB_NOMOD;
+
+    /* Combine the ops. */
+    *imopsp = append_elem(OP_LIST, *imopsp, imop);
+}
+
+/*
+=notfor apidoc apply_attrs_string
+
+Attempts to apply a list of attributes specified by the C<attrstr> and
+C<len> arguments to the subroutine identified by the C<cv> argument which
+is expected to be associated with the package identified by the C<stashpv>
+argument (see L<attributes>).  It gets this wrong, though, in that it
+does not correctly identify the boundaries of the individual attribute
+specifications within C<attrstr>.  This is not really intended for the
+public API, but has to be listed here for systems such as AIX which
+need an explicit export list for symbols.  (It's called from XS code
+in support of the C<ATTRS:> keyword from F<xsubpp>.)  Patches to fix it
+to respect attribute syntax properly would be welcome.
+
+=cut
+*/
+
 void
 Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv,
                         char *attrstr, STRLEN len)
@@ -1938,7 +2071,7 @@ Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv,
 }
 
 STATIC OP *
-S_my_kid(pTHX_ OP *o, OP *attrs)
+S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 {
     OP *kid;
     I32 type;
@@ -1949,12 +2082,15 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
     type = o->op_type;
     if (type == OP_LIST) {
 	for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
-	    my_kid(kid, attrs);
+	    my_kid(kid, attrs, imopsp);
     } else if (type == OP_UNDEF) {
 	return o;
     } else if (type == OP_RV2SV ||	/* "our" declaration */
 	       type == OP_RV2AV ||
 	       type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+      if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
+           yyerror(Perl_form(aTHX_ "Can't declare %s in my", OP_DESC(o)));
+        }
         if (attrs) {
             GV *gv = cGVOPx_gv(cUNOPo->op_first);
             PL_in_my = FALSE;
@@ -1963,11 +2099,12 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
                         (type == OP_RV2SV ? GvSV(gv) :
                          type == OP_RV2AV ? (SV*)GvAV(gv) :
                          type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
-                        attrs);
+                        attrs, FALSE);
         }
 	o->op_private |= OPpOUR_INTRO;
 	return o;
-    } else if (type != OP_PADSV &&
+    }
+    else if (type != OP_PADSV &&
 	     type != OP_PADAV &&
 	     type != OP_PADHV &&
 	     type != OP_PUSHMARK)
@@ -1979,7 +2116,6 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
     }
     else if (attrs && type != OP_PUSHMARK) {
 	HV *stash;
-	SV *padsv;
 	SV **namesvp;
 
 	PL_in_my = FALSE;
@@ -1991,8 +2127,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 	    stash = SvSTASH(*namesvp);
 	else
 	    stash = PL_curstash;
-	padsv = PAD_SV(o->op_targ);
-	apply_attrs(stash, padsv, attrs);
+	apply_attrs_my(stash, o, attrs, imopsp);
     }
     o->op_flags |= OPf_MOD;
     o->op_private |= OPpLVAL_INTRO;
@@ -2002,11 +2137,24 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 OP *
 Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 {
+    OP *rops = Nullop;
+    int maybe_scalar = 0;
+
     if (o->op_flags & OPf_PARENS)
 	list(o);
+    else
+	maybe_scalar = 1;
     if (attrs)
 	SAVEFREEOP(attrs);
-    o = my_kid(o, attrs);
+    o = my_kid(o, attrs, &rops);
+    if (rops) {
+	if (maybe_scalar && o->op_type == OP_PADSV) {
+	    o = scalar(append_list(OP_LIST, (LISTOP*)rops, (LISTOP*)o));
+	    o->op_private |= OPpLVAL_INTRO;
+	}
+	else
+	    o = append_list(OP_LIST, (LISTOP*)o, (LISTOP*)rops);
+    }
     PL_in_my = FALSE;
     PL_in_my_stash = Nullhv;
     return o;
@@ -2015,7 +2163,7 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 OP *
 Perl_my(pTHX_ OP *o)
 {
-    return my_kid(o, Nullop);
+    return my_attrs(o, Nullop);
 }
 
 OP *
@@ -2042,25 +2190,26 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
       const char *sample = ((left->op_type == OP_RV2AV ||
 			     left->op_type == OP_PADAV)
 			    ? "@array" : "%hash");
-      Perl_warner(aTHX_ WARN_MISC,
+      Perl_warner(aTHX_ packWARN(WARN_MISC),
              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);
     }
 
+    if (right->op_type == OP_CONST &&
+	cSVOPx(right)->op_private & OPpCONST_BARE &&
+	cSVOPx(right)->op_private & OPpCONST_STRICT)
+    {
+	no_bareword_allowed(right);
+    }
+
     if (!(right->op_flags & OPf_STACKED) &&
        (right->op_type == OP_MATCH ||
 	right->op_type == OP_SUBST ||
 	right->op_type == OP_TRANS)) {
 	right->op_flags |= OPf_STACKED;
-	if ((right->op_type != OP_MATCH &&
-	     ! (right->op_type == OP_TRANS &&
-		right->op_private & OPpTRANS_IDENTICAL)) ||
-	    /* if SV has magic, then match on original SV, not on its copy.
-	       see note in pp_helem() */
-	    (right->op_type == OP_MATCH &&	
-	     (left->op_type == OP_AELEM ||
-	      left->op_type == OP_HELEM ||
-	      left->op_type == OP_AELEMFAST)))
+	if (right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL))
 	    left = mod(left, right->op_type);
 	if (right->op_type == OP_TRANS)
 	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2161,7 +2310,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
     LEAVE_SCOPE(floor);
     PL_pad_reset_pending = FALSE;
-    PL_compiling.op_private = PL_hints;
+    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
 	PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy(PL_comppad_name_fill);
@@ -2237,7 +2386,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 		s++;
 
 	    if (*s == ';' || *s == '=')
-		Perl_warner(aTHX_ WARN_PARENTHESIS,
+		Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
 			    "Parentheses missing around \"%s\" list",
 			    lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
 	}
@@ -2355,30 +2504,6 @@ Perl_fold_constants(pTHX_ register OP *o)
     }
 
   nope:
-    if (!(PL_opargs[type] & OA_OTHERINT))
-	return o;
-
-    if (!(PL_hints & HINT_INTEGER)) {
-	if (type == OP_MODULO
-	    || type == OP_DIVIDE
-	    || !(o->op_flags & OPf_KIDS))
-	{
-	    return o;
-	}
-
-	for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
-	    if (curop->op_type == OP_CONST) {
-		if (SvIOK(((SVOP*)curop)->op_sv))
-		    continue;
-		return o;
-	    }
-	    if (PL_opargs[curop->op_type] & OA_RETINTEGER)
-		continue;
-	    return o;
-	}
-	o->op_ppaddr = PL_ppaddr[++(o->op_type)];
-    }
-
     return o;
 }
 
@@ -2403,6 +2528,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     o->op_type = OP_RV2AV;
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
+    o->op_seq = 0;		/* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
     op_free(curop);
@@ -2421,7 +2547,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
     if (!(PL_opargs[type] & OA_MARK))
 	op_null(cLISTOPo->op_first);
 
-    o->op_type = type;
+    o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags |= flags;
 
@@ -2478,10 +2604,8 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_flags |= (last->op_flags & OPf_KIDS);
 
-#ifdef PL_OP_SLAB_ALLOC
-#else
-    Safefree(last);
-#endif
+    FreeOp(last);
+
     return (OP*)first;
 }
 
@@ -2540,11 +2664,11 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 
     NewOp(1101, listop, 1, LISTOP);
 
-    listop->op_type = type;
+    listop->op_type = (OPCODE)type;
     listop->op_ppaddr = PL_ppaddr[type];
     if (first || last)
 	flags |= OPf_KIDS;
-    listop->op_flags = flags;
+    listop->op_flags = (U8)flags;
 
     if (!last && first)
 	last = first;
@@ -2572,12 +2696,12 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
 {
     OP *o;
     NewOp(1101, o, 1, OP);
-    o->op_type = type;
+    o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
-    o->op_flags = flags;
+    o->op_flags = (U8)flags;
 
     o->op_next = o;
-    o->op_private = 0 + (flags >> 8);
+    o->op_private = (U8)(0 | (flags >> 8));
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar(o);
     if (PL_opargs[type] & OA_TARGET)
@@ -2596,11 +2720,11 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 	first = force_list(first);
 
     NewOp(1101, unop, 1, UNOP);
-    unop->op_type = type;
+    unop->op_type = (OPCODE)type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
     unop->op_flags = flags | OPf_KIDS;
-    unop->op_private = 1 | (flags >> 8);
+    unop->op_private = (U8)(1 | (flags >> 8));
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
 	return (OP*)unop;
@@ -2617,21 +2741,21 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     if (!first)
 	first = newOP(OP_NULL, 0);
 
-    binop->op_type = type;
+    binop->op_type = (OPCODE)type;
     binop->op_ppaddr = PL_ppaddr[type];
     binop->op_first = first;
     binop->op_flags = flags | OPf_KIDS;
     if (!last) {
 	last = first;
-	binop->op_private = 1 | (flags >> 8);
+	binop->op_private = (U8)(1 | (flags >> 8));
     }
     else {
-	binop->op_private = 2 | (flags >> 8);
+	binop->op_private = (U8)(2 | (flags >> 8));
 	first->op_sibling = last;
     }
 
     binop = (BINOP*)CHECKOP(type, binop);
-    if (binop->op_next || binop->op_type != type)
+    if (binop->op_next || binop->op_type != (OPCODE)type)
 	return (OP*)binop;
 
     binop->op_last = binop->op_first->op_sibling;
@@ -2765,7 +2889,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		U8 range_mark = UTF_TO_NATIVE(0xff);
 		sv_catpvn(transv, (char *)&range_mark, 1);
 	    }
-	    t = uvuni_to_utf8(tmpbuf, 0x7fffffff);
+	    t = uvuni_to_utf8_flags(tmpbuf, 0x7fffffff,
+				    UNICODE_ALLOW_SUPER);
 	    sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
 	    t = (U8*)SvPVX(transv);
 	    tlen = SvCUR(transv);
@@ -2890,17 +3015,17 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     tbl = (short*)cPVOPo->op_pv;
     if (complement) {
 	Zero(tbl, 256, short);
-	for (i = 0; i < tlen; i++)
+	for (i = 0; i < (I32)tlen; i++)
 	    tbl[t[i]] = -1;
 	for (i = 0, j = 0; i < 256; i++) {
 	    if (!tbl[i]) {
-		if (j >= rlen) {
+		if (j >= (I32)rlen) {
 		    if (del)
 			tbl[i] = -2;
 		    else if (rlen)
 			tbl[i] = r[j-1];
 		    else
-			tbl[i] = i;
+			tbl[i] = (short)i;
 		}
 		else {
 		    if (i < 128 && r[j] >= 128)
@@ -2915,12 +3040,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		if (!squash)
 		    o->op_private |= OPpTRANS_IDENTICAL;
 	    }
-	    else if (j >= rlen)
+	    else if (j >= (I32)rlen)
 		j = rlen - 1;
 	    else
 		cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
 	    tbl[0x100] = rlen - j;
-	    for (i=0; i < rlen - j; i++)
+	    for (i=0; i < (I32)rlen - j; i++)
 		tbl[0x101+i] = r[j+i];
 	}
     }
@@ -2930,10 +3055,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	    if (!squash)
 		o->op_private |= OPpTRANS_IDENTICAL;
 	}
+	else if (!squash && rlen == tlen && memEQ((char*)t, (char*)r, tlen)) {
+	    o->op_private |= OPpTRANS_IDENTICAL;
+	}
 	for (i = 0; i < 256; i++)
 	    tbl[i] = -1;
-	for (i = 0, j = 0; i < tlen; i++,j++) {
-	    if (j >= rlen) {
+	for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
+	    if (j >= (I32)rlen) {
 		if (del) {
 		    if (tbl[t[i]] == -1)
 			tbl[t[i]] = -2;
@@ -2962,10 +3090,10 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     PMOP *pmop;
 
     NewOp(1101, pmop, 1, PMOP);
-    pmop->op_type = type;
+    pmop->op_type = (OPCODE)type;
     pmop->op_ppaddr = PL_ppaddr[type];
-    pmop->op_flags = flags;
-    pmop->op_private = 0 | (flags >> 8);
+    pmop->op_flags = (U8)flags;
+    pmop->op_private = (U8)(0 | (flags >> 8));
 
     if (PL_hints & HINT_RE_TAINT)
 	pmop->op_pmpermflags |= PMf_RETAINT;
@@ -2981,7 +3109,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
             pmop->op_pmoffset = SvIV(repointer);
 	    SvREPADTMP_off(repointer);
 	    sv_setiv(repointer,0);
-        } else { 
+        } else {
             repointer = newSViv(0);
             av_push(PL_regex_padav,SvREFCNT_inc(repointer));
             pmop->op_pmoffset = av_len(PL_regex_padav);
@@ -2989,7 +3117,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
         }
     }
 #endif
-        
+
         /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
@@ -3022,6 +3150,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	    p = SvPV(pat, plen);
 	    pm->op_pmflags |= PMf_SKIPWHITE;
 	}
+        if (DO_UTF8(pat))
+	    pm->op_pmdynflags |= PMdf_UTF8;
 	PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
 	if (strEQ("\\s+", PM_GETRE(pm)->precomp))
 	    pm->op_pmflags |= PMf_WHITE;
@@ -3062,7 +3192,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = 0;
 	    if (CopLINE(PL_curcop) < PL_multi_end)
-		CopLINE_set(PL_curcop, PL_multi_end);
+		CopLINE_set(PL_curcop, (line_t)PL_multi_end);
 	}
 #ifdef USE_5005THREADS
 	else if (repl->op_type == OP_THREADSV
@@ -3154,11 +3284,11 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
     SVOP *svop;
     NewOp(1101, svop, 1, SVOP);
-    svop->op_type = type;
+    svop->op_type = (OPCODE)type;
     svop->op_ppaddr = PL_ppaddr[type];
     svop->op_sv = sv;
     svop->op_next = (OP*)svop;
-    svop->op_flags = flags;
+    svop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)svop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3171,14 +3301,14 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
     PADOP *padop;
     NewOp(1101, padop, 1, PADOP);
-    padop->op_type = type;
+    padop->op_type = (OPCODE)type;
     padop->op_ppaddr = PL_ppaddr[type];
     padop->op_padix = pad_alloc(type, SVs_PADTMP);
     SvREFCNT_dec(PL_curpad[padop->op_padix]);
     PL_curpad[padop->op_padix] = sv;
     SvPADTMP_on(sv);
     padop->op_next = (OP*)padop;
-    padop->op_flags = flags;
+    padop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)padop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3202,11 +3332,11 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 {
     PVOP *pvop;
     NewOp(1101, pvop, 1, PVOP);
-    pvop->op_type = type;
+    pvop->op_type = (OPCODE)type;
     pvop->op_ppaddr = PL_ppaddr[type];
     pvop->op_pv = pv;
     pvop->op_next = (OP*)pvop;
-    pvop->op_flags = flags;
+    pvop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)pvop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3246,9 +3376,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     OP *pack;
     OP *imop;
     OP *veop;
-    char *packname = Nullch;
-    STRLEN packlen = 0;
-    SV *packsv;
 
     if (id->op_type != OP_CONST)
 	Perl_croak(aTHX_ "Module name must be constant");
@@ -3296,8 +3423,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
 	/* Fake up a method call to import/unimport */
-	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);;
-	sv_upgrade(meth, SVt_PVIV);
+	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
+	(void)SvUPGRADE(meth, SVt_PVIV);
 	(void)SvIOK_on(meth);
 	PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
 	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
@@ -3306,15 +3433,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 				   newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
-    if (ckWARN(WARN_MISC) &&
-        imop && (imop != arg) && /* no warning on use 5.0; or explicit () */
-        SvPOK(packsv = ((SVOP*)id)->op_sv))
-    {
-        /* BEGIN will free the ops, so we need to make a copy */
-        packlen = SvCUR(packsv);
-        packname = savepvn(SvPVX(packsv), packlen);
-    }
-
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newATTRSUB(floor,
 	newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
@@ -3326,14 +3444,22 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	        newSTATEOP(0, Nullch, veop)),
 	    newSTATEOP(0, Nullch, imop) ));
 
-    if (packname) {
-        if (ckWARN(WARN_MISC) && !gv_stashpvn(packname, packlen, FALSE)) {
-            Perl_warner(aTHX_ WARN_MISC,
-                        "Package `%s' not found "
-                        "(did you use the incorrect case?)", packname);
-        }
-        safefree(packname);
-    }
+    /* The "did you use incorrect case?" warning used to be here.
+     * The problem is that on case-insensitive filesystems one
+     * might get false positives for "use" (and "require"):
+     * "use Strict" or "require CARP" will work.  This causes
+     * portability problems for the script: in case-strict
+     * filesystems the script will stop working.
+     *
+     * The "incorrect case" warning checked whether "use Foo"
+     * imported "Foo" to your namespace, but that is wrong, too:
+     * there is no requirement nor promise in the language that
+     * a Foo.pm should or would contain anything in package "Foo".
+     *
+     * There is very little Configure-wise that can be done, either:
+     * the case-sensitivity of the build filesystem of Perl does not
+     * help in guessing the case-sensitivity of the runtime environment.
+     */
 
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
@@ -3341,6 +3467,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 }
 
 /*
+=head1 Embedding Functions
+
 =for apidoc load_module
 
 Loads the module whose name is pointed to by the string part of name.
@@ -3420,10 +3548,10 @@ Perl_dofile(pTHX_ OP *term)
     GV *gv;
 
     gv = gv_fetchpv("do", FALSE, SVt_PVCV);
-    if (!(gv && GvIMPORTED_CV(gv)))
+    if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv)))
 	gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
 
-    if (gv && GvIMPORTED_CV(gv)) {
+    if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
 	doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
 			       append_elem(OP_LIST, term,
 					   scalar(newUNOP(OP_RV2CV, 0,
@@ -3464,6 +3592,11 @@ S_list_assignment(pTHX_ register OP *o)
 	return FALSE;
     }
 
+    if (o->op_type == OP_LIST &&
+	(o->op_flags & OPf_WANT) == OPf_WANT_SCALAR &&
+	o->op_private & OPpLVAL_INTRO)
+	return FALSE;
+
     if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
 	o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
 	o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
@@ -3510,7 +3643,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	}
 	curop = list(force_list(left));
 	o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
-	o->op_private = 0 | (flags >> 8);
+	o->op_private = (U8)(0 | (flags >> 8));
 	for (curop = ((LISTOP*)curop)->op_first;
 	     curop; curop = curop->op_sibling)
 	{
@@ -3527,7 +3660,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
 		    if (curop->op_type == OP_GV) {
 			GV *gv = cGVOPx_gv(curop);
-			if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+			if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
 			    break;
 			SvCUR(gv) = PL_generation;
 		    }
@@ -3537,7 +3670,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			     curop->op_type == OP_PADANY) {
 			SV **svp = AvARRAY(PL_comppad_name);
 			SV *sv = svp[curop->op_targ];
-			if (SvCUR(sv) == PL_generation)
+			if ((int)SvCUR(sv) == PL_generation)
 			    break;
 			SvCUR(sv) = PL_generation;	/* (SvCUR not used any more) */
 		    }
@@ -3553,14 +3686,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    else if (curop->op_type == OP_PUSHRE) {
 			if (((PMOP*)curop)->op_pmreplroot) {
 #ifdef USE_ITHREADS
-			    GV *gv = (GV*)PL_curpad[(PADOFFSET)((PMOP*)curop)->op_pmreplroot];
+			    GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET,((PMOP*)curop)->op_pmreplroot)];
 #else
 			    GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
 #endif
-			    if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+			    if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
 				break;
 			    SvCUR(gv) = PL_generation;
-			}	
+			}
 		    }
 		    else
 			break;
@@ -3583,7 +3716,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    tmpop = ((UNOP*)left)->op_first;
 		    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
 #ifdef USE_ITHREADS
-			pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+			pm->op_pmreplroot = INT2PTR(OP*, cPADOPx(tmpop)->op_padix);
 			cPADOPx(tmpop)->op_padix = 0;	/* steal it */
 #else
 			pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
@@ -3648,8 +3781,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	cop->op_type = OP_NEXTSTATE;
 	cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
-    cop->op_flags = flags;
-    cop->op_private = (PL_hints & HINT_PRIVATE_MASK);
+    cop->op_flags = (U8)flags;
+    cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -3687,8 +3820,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
 	SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
-	if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
-	    (void)SvIOK_on(*svp);
+        if (svp && *svp != &PL_sv_undef ) {
+           (void)SvIOK_on(*svp);
 	    SvIVX(*svp) = PTR2IV(cop);
 	}
     }
@@ -3754,7 +3887,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     }
     if (first->op_type == OP_CONST) {
 	if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
-	    Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
+	    Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
 	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
 	    op_free(first);
 	    *firstp = Nullop;
@@ -3794,14 +3927,14 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 		  || k1->op_type == OP_EACH)
 	    {
 		warnop = ((k1->op_type == OP_NULL)
-			  ? k1->op_targ : k1->op_type);
+			  ? (OPCODE)k1->op_targ : k1->op_type);
 	    }
 	    break;
 	}
 	if (warnop) {
 	    line_t oldline = CopLINE(PL_curcop);
 	    CopLINE_set(PL_curcop, PL_copline);
-	    Perl_warner(aTHX_ WARN_MISC,
+	    Perl_warner(aTHX_ packWARN(WARN_MISC),
 		 "Value of %s%s can be \"0\"; test with defined()",
 		 PL_op_desc[warnop],
 		 ((warnop == OP_READLINE || warnop == OP_GLOB)
@@ -3818,12 +3951,12 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     NewOp(1101, logop, 1, LOGOP);
 
-    logop->op_type = type;
+    logop->op_type = (OPCODE)type;
     logop->op_ppaddr = PL_ppaddr[type];
     logop->op_first = first;
     logop->op_flags = flags | OPf_KIDS;
     logop->op_other = LINKLIST(other);
-    logop->op_private = 1 | (flags >> 8);
+    logop->op_private = (U8)(1 | (flags >> 8));
 
     /* establish postfix order */
     logop->op_next = LINKLIST(first);
@@ -3870,7 +4003,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
     logop->op_first = first;
     logop->op_flags = flags | OPf_KIDS;
-    logop->op_private = 1 | (flags >> 8);
+    logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);
 
@@ -3906,7 +4039,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
     range->op_flags = OPf_KIDS;
     leftstart = LINKLIST(left);
     range->op_other = LINKLIST(right);
-    range->op_private = 1 | (flags >> 8);
+    range->op_private = (U8)(1 | (flags >> 8));
 
     left->op_sibling = right;
 
@@ -3964,7 +4097,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 	      case OP_SASSIGN:
 		if (k1->op_type == OP_READDIR
 		      || k1->op_type == OP_GLOB
-		      || (k1->op_type == OP_NULL && k1->op_targ == OP_NULL)
+		      || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
 		      || k1->op_type == OP_EACH)
 		    expr = newUNOP(OP_DEFINED, 0, expr);
 		break;
@@ -4039,7 +4172,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 	    next = unstack;
 	cont = append_elem(OP_LINESEQ, cont, unstack);
 	if ((line_t)whileline != NOLINE) {
-	    PL_copline = whileline;
+	    PL_copline = (line_t)whileline;
 	    cont = append_elem(OP_LINESEQ, cont,
 			       newSTATEOP(0, Nullch, Nullop));
 	}
@@ -4049,7 +4182,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     redo = LINKLIST(listop);
 
     if (expr) {
-	PL_copline = whileline;
+	PL_copline = (line_t)whileline;
 	scalar(listop);
 	o = new_logop(OP_AND, 0, &expr, &listop);
 	if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
@@ -4093,7 +4226,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 {
     LOOP *loop;
     OP *wop;
-    int padoff = 0;
+    PADOFFSET padoff = 0;
     I32 iterflags = 0;
 
     if (sv) {
@@ -4170,6 +4303,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 	LOOP *tmp;
 	NewOp(1234,tmp,1,LOOP);
 	Copy(loop,tmp,1,LOOP);
+	FreeOp(loop);
 	loop = tmp;
     }
 #else
@@ -4249,15 +4383,9 @@ Perl_cv_undef(pTHX_ CV *cv)
      * CV, they don't hold a refcount on the outside CV.  This avoids
      * the refcount loop between the outer CV (which keeps a refcount to
      * the closure prototype in the pad entry for pp_anoncode()) and the
-     * closure prototype, and the ensuing memory leak.  This does not
-     * apply to closures generated within eval"", since eval"" CVs are
-     * ephemeral. --GSAR */
-    if (!CvANON(cv) || CvCLONED(cv)
-	|| (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
-	    && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
-    {
+     * closure prototype, and the ensuing memory leak.  --GSAR */
+    if (!CvANON(cv) || CvCLONED(cv))
 	SvREFCNT_dec(CvOUTSIDE(cv));
-    }
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4514,13 +4642,16 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 	    Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
 	else
 	    sv_catpv(msg, "none");
-	Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
+	Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, msg);
     }
 }
 
 static void const_sv_xsub(pTHX_ CV* cv);
 
 /*
+
+=head1 Optree Manipulation Functions
+
 =for apidoc cv_const_sv
 
 If C<cv> is a constant sub eligible for inlining. returns the constant
@@ -4626,13 +4757,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
     if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
 	SV *sv = sv_newmortal();
-	Perl_sv_setpvf(aTHX_ sv, "__ANON__[%s:%"IVdf"]",
+	Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
+		       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
 		       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
 	aname = SvPVX(sv);
     }
     else
 	aname = Nullch;
-    gv = gv_fetchpv(name ? name : (aname ? aname : "__ANON__"),
+    gv = gv_fetchpv(name ? name : (aname ? aname : 
+		    (PL_curstash ? "__ANON__" : "__ANON__::__ANON__")),
 		    GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
 		    SVt_PVCV);
 
@@ -4649,7 +4782,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
 		&& ckWARN_d(WARN_PROTOTYPE))
 	    {
-		Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
+		Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
 	    }
 	    cv_ckproto((CV*)gv, NULL, ps);
 	}
@@ -4694,6 +4827,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	/* already defined (or promised)? */
 	if (exists || GvASSUMECV(gv)) {
 	    if (!block && !attrs) {
+		if (CvFLAGS(PL_compcv)) {
+		    /* might have had built-in attrs applied */
+		    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+		}
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(PL_compcv);
 		goto done;
@@ -4709,7 +4846,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		    line_t oldline = CopLINE(PL_curcop);
 		    if (PL_copline != NOLINE)
 			CopLINE_set(PL_curcop, PL_copline);
-		    Perl_warner(aTHX_ WARN_REDEFINE,
+		    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 			CvCONST(cv) ? "Constant subroutine %s redefined"
 				    : "Subroutine %s redefined", name);
 		    CopLINE_set(PL_curcop, oldline);
@@ -4747,6 +4884,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	 */
 	if (cv && !block) {
 	    rcv = (SV*)cv;
+	    /* Might have had built-in attributes applied -- propagate them. */
+	    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
 	    if (CvGV(cv) && GvSTASH(CvGV(cv)))
 		stash = GvSTASH(CvGV(cv));
 	    else if (CvSTASH(cv))
@@ -4762,7 +4901,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    else
 		stash = PL_curstash;
 	}
-	apply_attrs(stash, rcv, attrs);
+	apply_attrs(stash, rcv, attrs, FALSE);
     }
     if (cv) {				/* must reuse cv if autoloaded */
 	if (!block) {
@@ -4904,17 +5043,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
     }
 
-    /* If a potential closure prototype, don't keep a refcount on
-     * outer CV, unless the latter happens to be a passing eval"".
+    /* If a potential closure prototype, don't keep a refcount on outer CV.
      * This is okay as the lifetime of the prototype is tied to the
      * lifetime of the outer CV.  Avoids memory leak due to reference
      * loop. --GSAR */
-    if (!name && CvOUTSIDE(cv)
-	&& !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
-	     && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
-    {
+    if (!name)
 	SvREFCNT_dec(CvOUTSIDE(cv));
-    }
 
     if (name || aname) {
 	char *s;
@@ -4957,8 +5091,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    ENTER;
 	    SAVECOPFILE(&PL_compiling);
 	    SAVECOPLINE(&PL_compiling);
-	    save_svref(&PL_rs);
-	    sv_setsv(PL_rs, PL_nrs);
 
 	    if (!PL_beginav)
 		PL_beginav = newAV();
@@ -4968,7 +5100,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    call_list(oldscope, PL_beginav);
 
 	    PL_curcop = &PL_compiling;
-	    PL_compiling.op_private = PL_hints;
+	    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 	    LEAVE;
 	}
 	else if (strEQ(s, "END") && !PL_error_count) {
@@ -4984,7 +5116,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		PL_checkav = newAV();
 	    DEBUG_x( dump_sub(gv) );
 	    if (PL_main_start && ckWARN(WARN_VOID))
-		Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+		Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block");
 	    av_unshift(PL_checkav, 1);
 	    av_store(PL_checkav, 0, (SV*)cv);
 	    GvCV(gv) = 0;		/* cv has been hijacked */
@@ -4994,7 +5126,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		PL_initav = newAV();
 	    DEBUG_x( dump_sub(gv) );
 	    if (PL_main_start && ckWARN(WARN_VOID))
-		Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
+		Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block");
 	    av_push(PL_initav, (SV*)cv);
 	    GvCV(gv) = 0;		/* cv has been hijacked */
 	}
@@ -5033,11 +5165,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	SAVESPTR(PL_curstash);
 	SAVECOPSTASH(PL_curcop);
 	PL_curstash = stash;
-#ifdef USE_ITHREADS
-	CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
-#else
-	CopSTASH(PL_curcop) = stash;
-#endif
+	CopSTASH_set(PL_curcop,stash);
     }
 
     cv = newXS(name, const_sv_xsub, __FILE__);
@@ -5061,7 +5189,9 @@ Used by C<xsubpp> to hook up XSUBs as Perl subs.
 CV *
 Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 {
-    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
+    GV *gv = gv_fetchpv(name ? name :
+			(PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
+			GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
     if ((cv = (name ? GvCV(gv) : Nullcv))) {
@@ -5077,7 +5207,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 		line_t oldline = CopLINE(PL_curcop);
 		if (PL_copline != NOLINE)
 		    CopLINE_set(PL_curcop, PL_copline);
-		Perl_warner(aTHX_ WARN_REDEFINE,
+		Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 			    CvCONST(cv) ? "Constant subroutine %s redefined"
 					: "Subroutine %s redefined"
 			    ,name);
@@ -5137,7 +5267,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	    if (!PL_checkav)
 		PL_checkav = newAV();
 	    if (PL_main_start && ckWARN(WARN_VOID))
-		Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+		Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK block");
 	    av_unshift(PL_checkav, 1);
 	    av_store(PL_checkav, 0, (SV*)cv);
 	    GvCV(gv) = 0;		/* cv has been hijacked */
@@ -5146,7 +5276,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	    if (!PL_initav)
 		PL_initav = newAV();
 	    if (PL_main_start && ckWARN(WARN_VOID))
-		Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
+		Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT block");
 	    av_push(PL_initav, (SV*)cv);
 	    GvCV(gv) = 0;		/* cv has been hijacked */
 	}
@@ -5183,7 +5313,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 	    line_t oldline = CopLINE(PL_curcop);
 	    if (PL_copline != NOLINE)
 		CopLINE_set(PL_curcop, PL_copline);
-	    Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
+	    Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name);
 	    CopLINE_set(PL_curcop, oldline);
 	}
 	SvREFCNT_dec(cv);
@@ -5245,7 +5375,7 @@ Perl_oopsAV(pTHX_ OP *o)
 	o->op_type = OP_PADAV;
 	o->op_ppaddr = PL_ppaddr[OP_PADAV];
 	return ref(o, OP_RV2AV);
-	
+
     case OP_RV2SV:
 	o->op_type = OP_RV2AV;
 	o->op_ppaddr = PL_ppaddr[OP_RV2AV];
@@ -5254,7 +5384,7 @@ Perl_oopsAV(pTHX_ OP *o)
 
     default:
 	if (ckWARN_d(WARN_INTERNAL))
-	    Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV");
+	    Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV");
 	break;
     }
     return o;
@@ -5279,7 +5409,7 @@ Perl_oopsHV(pTHX_ OP *o)
 
     default:
 	if (ckWARN_d(WARN_INTERNAL))
-	    Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsHV");
+	    Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV");
 	break;
     }
     return o;
@@ -5295,7 +5425,7 @@ Perl_newAVREF(pTHX_ OP *o)
     }
     else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
 		&& ckWARN(WARN_DEPRECATED)) {
-	Perl_warner(aTHX_ WARN_DEPRECATED,
+	Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
 		"Using an array as a reference is deprecated");
     }
     return newUNOP(OP_RV2AV, 0, scalar(o));
@@ -5319,7 +5449,7 @@ Perl_newHVREF(pTHX_ OP *o)
     }
     else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
 		&& ckWARN(WARN_DEPRECATED)) {
-	Perl_warner(aTHX_ WARN_DEPRECATED,
+	Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
 		"Using a hash as a reference is deprecated");
     }
     return newUNOP(OP_RV2HV, 0, scalar(o));
@@ -5379,7 +5509,7 @@ Perl_ck_anoncode(pTHX_ OP *o)
 OP *
 Perl_ck_bitop(pTHX_ OP *o)
 {
-    o->op_private = PL_hints;
+    o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     return o;
 }
 
@@ -5406,7 +5536,7 @@ Perl_ck_spair(pTHX_ OP *o)
 	     !(PL_opargs[newop->op_type] & OA_RETSCALAR) ||
 	     newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
 	     newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-	
+
 	    return o;
 	}
 	op_free(kUNOP->op_first);
@@ -5445,6 +5575,15 @@ Perl_ck_delete(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_die(pTHX_ OP *o)
+{
+#ifdef VMS
+    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
+#endif
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_eof(pTHX_ OP *o)
 {
     I32 type = o->op_type;
@@ -5513,6 +5652,7 @@ Perl_ck_exit(pTHX_ OP *o)
        if (svp && *svp && SvTRUE(*svp))
            o->op_private |= OPpEXIT_VMSISH;
     }
+    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
 #endif
     return ck_fun(o);
 }
@@ -5760,18 +5900,18 @@ Perl_ck_fun(pTHX_ OP *o)
 	    case OA_AVREF:
 		if ((type == OP_PUSH || type == OP_UNSHIFT)
 		    && !kid->op_sibling && ckWARN(WARN_SYNTAX))
-		    Perl_warner(aTHX_ WARN_SYNTAX,
+		    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
 			"Useless use of %s with no values",
 			PL_op_desc[type]);
-		    
+
 		if (kid->op_type == OP_CONST &&
 		    (kid->op_private & OPpCONST_BARE))
 		{
 		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVAV) ));
-		    if (ckWARN(WARN_DEPRECATED))
-			Perl_warner(aTHX_ WARN_DEPRECATED,
+		    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
+			Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			    "Array @%s missing the @ in argument %"IVdf" of %s()",
 			    name, (IV)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -5790,8 +5930,8 @@ Perl_ck_fun(pTHX_ OP *o)
 		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVHV) ));
-		    if (ckWARN(WARN_DEPRECATED))
-			Perl_warner(aTHX_ WARN_DEPRECATED,
+		    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
+			Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			    "Hash %%%s missing the %% in argument %"IVdf" of %s()",
 			    name, (IV)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -5822,6 +5962,9 @@ Perl_ck_fun(pTHX_ OP *o)
 			OP *newop = newGVOP(OP_GV, 0,
 			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
 					SVt_PVIO) );
+			if (!(o->op_private & 1) && /* if not unop */
+			    kid == cLISTOPo->op_last)
+			    cLISTOPo->op_last = newop;
 			op_free(kid);
 			kid = newop;
 		    }
@@ -5921,16 +6064,19 @@ Perl_ck_glob(pTHX_ OP *o)
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
 	append_elem(OP_GLOB, o, newDEFSVOP());
 
-    if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
+    if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV))
+	  && GvCVu(gv) && GvIMPORTED_CV(gv)))
+    {
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
+    }
 
 #if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
 	GV *glob_gv;
 	ENTER;
-	Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("File::Glob", 10), Nullsv,
-			 Nullsv, Nullsv);
+	Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+		newSVpvn("File::Glob", 10), Nullsv, Nullsv, Nullsv);
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 	glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV);
 	GvCV(gv) = GvCV(glob_gv);
@@ -5940,7 +6086,7 @@ Perl_ck_glob(pTHX_ OP *o)
     }
 #endif /* PERL_EXTERNAL_GLOB */
 
-    if (gv && GvIMPORTED_CV(gv)) {
+    if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
 	append_elem(OP_GLOB, o,
 		    newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
 	o->op_type = OP_LIST;
@@ -6043,7 +6189,7 @@ Perl_ck_lfun(pTHX_ OP *o)
 OP *
 Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
 {
-    if ((o->op_flags & OPf_KIDS) && ckWARN(WARN_DEPRECATED)) {
+    if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) {
 	switch (cUNOPo->op_first->op_type) {
 	case OP_RV2AV:
 	    /* This is needed for
@@ -6053,9 +6199,9 @@ Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
 	    break;                      /* Globals via GV can be undef */
 	case OP_PADAV:
 	case OP_AASSIGN:		/* Is this a good idea? */
-	    Perl_warner(aTHX_ WARN_DEPRECATED,
+	    Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			"defined(@array) is deprecated");
-	    Perl_warner(aTHX_ WARN_DEPRECATED,
+	    Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			"\t(Maybe you should just omit the defined()?)\n");
 	break;
 	case OP_RV2HV:
@@ -6065,9 +6211,9 @@ Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
 	       */
 	    break;                      /* Globals via GV can be undef */
 	case OP_PADHV:
-	    Perl_warner(aTHX_ WARN_DEPRECATED,
+	    Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			"defined(%%hash) is deprecated");
-	    Perl_warner(aTHX_ WARN_DEPRECATED,
+	    Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			"\t(Maybe you should just omit the defined()?)\n");
 	    break;
 	default:
@@ -6108,7 +6254,7 @@ Perl_ck_listiob(pTHX_ OP *o)
 	    kid = kid->op_sibling;
 	}
     }
-	
+
     if (!kid)
 	append_elem(o->op_type, o, newDEFSVOP());
 
@@ -6251,10 +6397,10 @@ Perl_ck_require(pTHX_ OP *o)
 
     /* handle override, if any */
     gv = gv_fetchpv("require", FALSE, SVt_PVCV);
-    if (!(gv && GvIMPORTED_CV(gv)))
+    if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv)))
 	gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
 
-    if (gv && GvIMPORTED_CV(gv)) {
+    if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
 	OP *kid = cUNOPo->op_first;
 	cUNOPo->op_first = 0;
 	op_free(o);
@@ -6316,7 +6462,7 @@ Perl_ck_shift(pTHX_ OP *o)
 
     if (!(o->op_flags & OPf_KIDS)) {
 	OP *argop;
-	
+
 	op_free(o);
 #ifdef USE_5005THREADS
 	if (!CvUNIQUE(PL_compcv)) {
@@ -6497,6 +6643,10 @@ Perl_ck_split(pTHX_ OP *o)
     kid->op_type = OP_PUSHRE;
     kid->op_ppaddr = PL_ppaddr[OP_PUSHRE];
     scalar(kid);
+    if (ckWARN(WARN_REGEXP) && ((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
+      Perl_warner(aTHX_ packWARN(WARN_REGEXP),
+                  "Use of /g modifier is meaningless in split");
+    }
 
     if (!kid->op_sibling)
 	append_elem(OP_SPLIT, o, newDEFSVOP());
@@ -6525,7 +6675,7 @@ Perl_ck_join(pTHX_ OP *o)
 	    char *pmstr = "STRING";
 	    if (PM_GETRE(kPMOP))
 		pmstr = PM_GETRE(kPMOP)->precomp;
-	    Perl_warner(aTHX_ WARN_SYNTAX,
+	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
 			"/%s/ should probably be written as \"%s\"",
 			pmstr, pmstr);
 	}
@@ -6546,7 +6696,7 @@ Perl_ck_subr(pTHX_ OP *o)
     int optional = 0;
     I32 arg = 0;
     I32 contextclass = 0;
-    char *e;
+    char *e = 0;
     STRLEN n_a;
 
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -6653,7 +6803,7 @@ Perl_ck_subr(pTHX_ OP *o)
 		switch (*proto++) {
 		case '[':
 		     if (contextclass++ == 0) {
-			  e = strchr(proto, ']');
+		          e = strchr(proto, ']');
 			  if (!e || e == proto)
 			       goto oops;
 		     }
@@ -6662,9 +6812,16 @@ Perl_ck_subr(pTHX_ OP *o)
 		     goto again;
 		     break;
 		case ']':
-		     if (contextclass)
-			  contextclass = 0;
-		     else
+		     if (contextclass) {
+			 char *p = proto;
+			 char s = *p;
+			 contextclass = 0;
+			 *p = '\0';
+			 while (*--p != '[');
+			 bad_type(arg, Perl_form(aTHX_ "one of %s", p),
+				 gv_ename(namegv), o2);
+			 *proto = s;
+		     } else
 			  goto oops;
 		     break;
 		case '*':
@@ -6712,7 +6869,7 @@ Perl_ck_subr(pTHX_ OP *o)
 			o2->op_sibling = sib;
 			prev->op_sibling = o2;
 		    }
-		    if (contextclass) {
+		    if (contextclass && e) {
 			 proto = e + 1;
 			 contextclass = 0;
 		    }
@@ -6905,7 +7062,7 @@ Perl_peep(pTHX_ register OP *o)
 	    else if (o->op_next->op_type == OP_RV2AV) {
 		OP* pop = o->op_next->op_next;
 		IV i;
-		if (pop->op_type == OP_CONST &&
+		if (pop && pop->op_type == OP_CONST &&
 		    (PL_op = pop->op_next) &&
 		    pop->op_next->op_type == OP_AELEM &&
 		    !(pop->op_next->op_private &
@@ -6933,7 +7090,7 @@ Perl_peep(pTHX_ register OP *o)
 		    /* XXX could check prototype here instead of just carping */
 		    SV *sv = sv_newmortal();
 		    gv_efullname3(sv, gv, Nullch);
-		    Perl_warner(aTHX_ WARN_PROTOTYPE,
+		    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
 				"%s() called too early to check prototype",
 				SvPV_nolen(sv));
 		}
@@ -6942,10 +7099,12 @@ Perl_peep(pTHX_ register OP *o)
 		    && o->op_next->op_next->op_type == OP_CONCAT
 		    && (o->op_next->op_next->op_flags & OPf_STACKED))
 	    {
-		/* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010811 */
-		o->op_next->op_type   = OP_RCATLINE;
-		o->op_next->op_flags |= OPf_STACKED;
+		/* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010917 */
+		o->op_type   = OP_RCATLINE;
+		o->op_flags |= OPf_STACKED;
+		o->op_ppaddr = PL_ppaddr[OP_RCATLINE];
 		op_null(o->op_next->op_next);
+		op_null(o->op_next);
 	    }
 
 	    o->op_seq = PL_op_seqmax++;
@@ -7000,15 +7159,15 @@ Perl_peep(pTHX_ register OP *o)
 		    line_t oldline = CopLINE(PL_curcop);
 
 		    CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
-		    Perl_warner(aTHX_ WARN_EXEC,
+		    Perl_warner(aTHX_ packWARN(WARN_EXEC),
 				"Statement unlikely to be reached");
-		    Perl_warner(aTHX_ WARN_EXEC,
+		    Perl_warner(aTHX_ packWARN(WARN_EXEC),
 				"\t(Maybe you meant system() when you said exec()?)\n");
 		    CopLINE_set(PL_curcop, oldline);
 		}
 	    }
 	    break;
-	
+
 	case OP_HELEM: {
 	    UNOP *rop;
 	    SV *lexname;
@@ -7017,7 +7176,7 @@ Perl_peep(pTHX_ register OP *o)
 	    I32 ind;
 	    char *key = NULL;
 	    STRLEN keylen;
-	
+
 	    o->op_seq = PL_op_seqmax++;
 
 	    if (((BINOP*)o)->op_last->op_type != OP_CONST)
@@ -7069,7 +7228,7 @@ Perl_peep(pTHX_ register OP *o)
 	    *svp = sv;
 	    break;
 	}
-	
+
 	case OP_HSLICE: {
 	    UNOP *rop;
 	    SV *lexname;
@@ -7143,8 +7302,9 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
-#ifdef PERL_CUSTOM_OPS
-char* custom_op_name(pTHX_ OP* o)
+
+
+char* Perl_custom_op_name(pTHX_ OP* o)
 {
     IV  index = PTR2IV(o->op_ppaddr);
     SV* keysv;
@@ -7162,7 +7322,7 @@ char* custom_op_name(pTHX_ OP* o)
     return SvPV_nolen(HeVAL(he));
 }
 
-char* custom_op_desc(pTHX_ OP* o)
+char* Perl_custom_op_desc(pTHX_ OP* o)
 {
     IV  index = PTR2IV(o->op_ppaddr);
     SV* keysv;
@@ -7179,7 +7339,7 @@ char* custom_op_desc(pTHX_ OP* o)
 
     return SvPV_nolen(HeVAL(he));
 }
-#endif
+
 
 #include "XSUB.h"
 
@@ -7198,4 +7358,3 @@ const_sv_xsub(pTHX_ CV* cv)
     ST(0) = (SV*)XSANY.any_ptr;
     XSRETURN(1);
 }
-