X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/57843af05bc7863df9b9bfb6b37e3a29d08532a9..2773b0134e92133071e6a6e343073023a65dd4d0:/op.c

diff --git a/op.c b/op.c
index 7e8d32e..35fa3f5 100644
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, 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.
@@ -22,12 +22,6 @@
 
 /* #define PL_OP_SLAB_ALLOC */
 
-/* XXXXXX testing */
-#define OP_REFCNT_LOCK		NOOP
-#define OP_REFCNT_UNLOCK	NOOP
-#define OpREFCNT_set(o,n)	NOOP
-#define OpREFCNT_dec(o)		0
-
 #ifdef PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
 static char    *PL_OpPtr  = NULL;
@@ -105,7 +99,7 @@ S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
 		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
-		     SvPV_nolen(cSVOPo->op_sv)));
+		     SvPV_nolen(cSVOPo_sv)));
 }
 
 /* "register" allocation */
@@ -117,11 +111,10 @@ Perl_pad_allocmy(pTHX_ char *name)
     PADOFFSET off;
     SV *sv;
 
-    if (!(
-	PL_in_my == KEY_our ||
-	isALPHA(name[1]) ||
-	(PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
-	name[1] == '_' && (int)strlen(name) > 2 ))
+    if (!(PL_in_my == KEY_our ||
+	  isALPHA(name[1]) ||
+	  (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
+	  (name[1] == '_' && (int)strlen(name) > 2)))
     {
 	if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
 	    /* 1999-02-27 mjd@plover.com */
@@ -144,22 +137,42 @@ Perl_pad_allocmy(pTHX_ char *name)
 	}
 	yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
-    if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
+    if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
 	SV **svp = AvARRAY(PL_comppad_name);
-	for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
+	HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
+	PADOFFSET top = AvFILLp(PL_comppad_name);
+	for (off = top; off > PL_comppad_name_floor; off--) {
 	    if ((sv = svp[off])
 		&& sv != &PL_sv_undef
 		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
+		&& (PL_in_my != KEY_our
+		    || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
 		&& strEQ(name, SvPVX(sv)))
 	    {
-		Perl_warner(aTHX_ WARN_UNSAFE,
-			"\"%s\" variable %s masks earlier declaration in same %s", 
-			(PL_in_my == KEY_our ? "our" : "my"),
-			name,
-			(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+		Perl_warner(aTHX_ WARN_MISC,
+		    "\"%s\" variable %s masks earlier declaration in same %s", 
+		    (PL_in_my == KEY_our ? "our" : "my"),
+		    name,
+		    (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+		--off;
 		break;
 	    }
 	}
+	if (PL_in_my == KEY_our) {
+	    do {
+		if ((sv = svp[off])
+		    && sv != &PL_sv_undef
+		    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
+		    && strEQ(name, SvPVX(sv)))
+		{
+		    Perl_warner(aTHX_ WARN_MISC,
+			"\"our\" variable %s redeclared", name);
+		    Perl_warner(aTHX_ WARN_MISC,
+			"(Did you mean \"local\" instead of \"our\"?)\n");
+		    break;
+		}
+	    } while ( off-- > 0 );
+	}
     }
     off = pad_alloc(OP_PADSV, SVs_PADMY);
     sv = NEWSV(1102,0);
@@ -167,15 +180,18 @@ Perl_pad_allocmy(pTHX_ char *name)
     sv_setpv(sv, name);
     if (PL_in_my_stash) {
 	if (*name != '$')
-	    yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"my\"",
-			 name));
+	    yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
+			 name, PL_in_my == KEY_our ? "our" : "my"));
 	SvOBJECT_on(sv);
 	(void)SvUPGRADE(sv, SVt_PVMG);
 	SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
 	PL_sv_objcount++;
     }
-    if (PL_in_my == KEY_our)
+    if (PL_in_my == KEY_our) {
+	(void)SvUPGRADE(sv, SVt_PVGV);
+	GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? (SV*)PL_curstash : (SV*)PL_defstash);
 	SvFLAGS(sv) |= SVpad_OUR;
+    }
     av_store(PL_comppad_name, off, sv);
     SvNVX(sv) = (NV)PAD_MAX;
     SvIVX(sv) = 0;			/* Not yet introduced--see newSTATEOP */
@@ -190,6 +206,31 @@ Perl_pad_allocmy(pTHX_ char *name)
     return off;
 }
 
+STATIC PADOFFSET
+S_pad_addlex(pTHX_ SV *proto_namesv)
+{
+    SV *namesv = NEWSV(1103,0);
+    PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY);
+    sv_upgrade(namesv, SVt_PVNV);
+    sv_setpv(namesv, SvPVX(proto_namesv));
+    av_store(PL_comppad_name, newoff, namesv);
+    SvNVX(namesv) = (NV)PL_curcop->cop_seq;
+    SvIVX(namesv) = PAD_MAX;			/* A ref, intro immediately */
+    SvFAKE_on(namesv);				/* A ref, not a real var */
+    if (SvFLAGS(proto_namesv) & SVpad_OUR) {	/* An "our" variable */
+	SvFLAGS(namesv) |= SVpad_OUR;
+	(void)SvUPGRADE(namesv, SVt_PVGV);
+	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
+    }
+    if (SvOBJECT(proto_namesv)) {		/* A typed var */
+	SvOBJECT_on(namesv);
+	(void)SvUPGRADE(namesv, SVt_PVMG);
+	SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
+	PL_sv_objcount++;
+    }
+    return newoff;
+}
+
 #define FINDLEX_NOSEARCH	1		/* don't search outer contexts */
 
 STATIC PADOFFSET
@@ -232,25 +273,10 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 		    }
 		    depth = 1;
 		}
-		oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
+		oldpad = (AV*)AvARRAY(curlist)[depth];
 		oldsv = *av_fetch(oldpad, off, TRUE);
 		if (!newoff) {		/* Not a mere clone operation. */
-		    SV *namesv = NEWSV(1103,0);
-		    newoff = pad_alloc(OP_PADSV, SVs_PADMY);
-		    sv_upgrade(namesv, SVt_PVNV);
-		    sv_setpv(namesv, name);
-		    av_store(PL_comppad_name, newoff, namesv);
-		    SvNVX(namesv) = (NV)PL_curcop->cop_seq;
-		    SvIVX(namesv) = PAD_MAX;	/* A ref, intro immediately */
-		    SvFAKE_on(namesv);		/* A ref, not a real var */
-		    if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */
-			SvFLAGS(namesv) |= SVpad_OUR;
-		    if (SvOBJECT(sv)) {		/* A typed var */
-			SvOBJECT_on(namesv);
-			(void)SvUPGRADE(namesv, SVt_PVMG);
-			SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
-			PL_sv_objcount++;
-		    }
+		    newoff = pad_addlex(sv);
 		    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
 			/* "It's closures all the way down." */
 			CvCLONE_on(PL_compcv);
@@ -264,8 +290,23 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 				 bcv && bcv != cv && !CvCLONE(bcv);
 				 bcv = CvOUTSIDE(bcv))
 			    {
-				if (CvANON(bcv))
+				if (CvANON(bcv)) {
+				    /* install the missing pad entry in intervening
+				     * nested subs and mark them cloneable.
+				     * XXX fix pad_foo() to not use globals */
+				    AV *ocomppad_name = PL_comppad_name;
+				    AV *ocomppad = PL_comppad;
+				    SV **ocurpad = PL_curpad;
+				    AV *padlist = CvPADLIST(bcv);
+				    PL_comppad_name = (AV*)AvARRAY(padlist)[0];
+				    PL_comppad = (AV*)AvARRAY(padlist)[1];
+				    PL_curpad = AvARRAY(PL_comppad);
+				    pad_addlex(sv);
+				    PL_comppad_name = ocomppad_name;
+				    PL_comppad = ocomppad;
+				    PL_curpad = ocurpad;
 				    CvCLONE_on(bcv);
+				}
 				else {
 				    if (ckWARN(WARN_CLOSURE)
 					&& !CvUNIQUE(bcv) && !CvUNIQUE(cv))
@@ -314,11 +355,13 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 		if (CxREALEVAL(cx))
 		    saweval = i;
 		break;
+	    case OP_DOFILE:
 	    case OP_REQUIRE:
-		/* require must have its own scope */
+		/* require/do must have their own scope */
 		return 0;
 	    }
 	    break;
+	case CXt_FORMAT:
 	case CXt_SUB:
 	    if (!saweval)
 		return 0;
@@ -475,13 +518,13 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     dTHR;
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" sv %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     return PL_curpad[po];		/* eventually we'll turn this into a macro */
 }
@@ -498,14 +541,18 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" free %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
+    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
 	SvPADTMP_off(PL_curpad[po]);
+#ifdef USE_ITHREADS
+	SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
+#endif
+    }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
@@ -520,11 +567,11 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -718,16 +765,18 @@ S_op_clear(pTHX_ OP *o)
     case OP_GV:
     case OP_AELEMFAST:
 #ifdef USE_ITHREADS
-	if (PL_curpad) {
-	    GV *gv = cGVOPo;
-	    pad_swipe(cPADOPo->op_padix);
-	    /* No GvIN_PAD_off(gv) here, because other references may still
-	     * exist on the pad */
-	    SvREFCNT_dec(gv);
-	}
-	cPADOPo->op_padix = 0;
+	if (cPADOPo->op_padix > 0) {
+	    if (PL_curpad) {
+		GV *gv = cGVOPo_gv;
+		pad_swipe(cPADOPo->op_padix);
+		/* No GvIN_PAD_off(gv) here, because other references may still
+		 * exist on the pad */
+		SvREFCNT_dec(gv);
+	    }
+	    cPADOPo->op_padix = 0;
+	}
 #else
-	SvREFCNT_dec(cGVOPo);
+	SvREFCNT_dec(cSVOPo->op_sv);
 	cSVOPo->op_sv = Nullsv;
 #endif
 	break;
@@ -754,11 +803,26 @@ S_op_clear(pTHX_ OP *o)
 	break;
     case OP_SUBST:
 	op_free(cPMOPo->op_pmreplroot);
-	cPMOPo->op_pmreplroot = Nullop;
-	/* FALL THROUGH */
+	goto clear_pmop;
     case OP_PUSHRE:
+#ifdef USE_ITHREADS
+	if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+	    if (PL_curpad) {
+		GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
+		pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+		/* No GvIN_PAD_off(gv) here, because other references may still
+		 * exist on the pad */
+		SvREFCNT_dec(gv);
+	    }
+	}
+#else
+	SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+#endif
+	/* FALL THROUGH */
     case OP_MATCH:
     case OP_QR:
+clear_pmop:
+	cPMOPo->op_pmreplroot = Nullop;
 	ReREFCNT_dec(cPMOPo->op_pmregexp);
 	cPMOPo->op_pmregexp = (REGEXP*)NULL;
 	break;
@@ -776,7 +840,9 @@ S_cop_free(pTHX_ COP* cop)
     Safefree(cop->cop_label);
 #ifdef USE_ITHREADS
     Safefree(CopFILE(cop));		/* XXXXX share in a pvtable? */
+    Safefree(CopSTASHPV(cop));		/* XXXXX share in a pvtable? */
 #else
+    /* NOTE: COP.cop_stash is not refcounted */
     SvREFCNT_dec(CopFILEGV(cop));
 #endif
     if (! specialWARN(cop->cop_warnings))
@@ -896,7 +962,7 @@ Perl_scalar(pTHX_ OP *o)
     case OP_LEAVETRY:
 	kid = cLISTOPo->op_first;
 	scalar(kid);
-	while (kid = kid->op_sibling) {
+	while ((kid = kid->op_sibling)) {
 	    if (kid->op_sibling)
 		scalarvoid(kid);
 	    else
@@ -1035,7 +1101,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_GGRGID:
     case OP_GETLOGIN:
       func_ops:
-	if (!(o->op_private & OPpLVAL_INTRO))
+	if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
 	    useless = PL_op_desc[o->op_type];
 	break;
 
@@ -1043,13 +1109,13 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_RV2SV:
     case OP_RV2AV:
     case OP_RV2HV:
-	if (!(o->op_private & OPpLVAL_INTRO) &&
+	if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
 		(!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
 	    useless = "a variable";
 	break;
 
     case OP_CONST:
-	sv = cSVOPo->op_sv;
+	sv = cSVOPo_sv;
 	if (cSVOPo->op_private & OPpCONST_STRICT)
 	    no_bareword_allowed(o);
 	else {
@@ -1189,7 +1255,7 @@ Perl_list(pTHX_ OP *o)
     case OP_LEAVETRY:
 	kid = cLISTOPo->op_first;
 	list(kid);
-	while (kid = kid->op_sibling) {
+	while ((kid = kid->op_sibling)) {
 	    if (kid->op_sibling)
 		scalarvoid(kid);
 	    else
@@ -1259,7 +1325,6 @@ Perl_mod(pTHX_ OP *o, I32 type)
 {
     dTHR;
     OP *kid;
-    SV *sv;
     STRLEN n_a;
 
     if (!o || PL_error_count)
@@ -1279,7 +1344,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	if (!(o->op_private & (OPpCONST_ARYBASE)))
 	    goto nomod;
 	if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
-	    PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
+	    PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
 	    PL_eval_start = 0;
 	}
 	else if (!type) {
@@ -1306,7 +1371,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	}
 	else {				/* lvalue subroutine call */
 	    o->op_private |= OPpLVAL_INTRO;
-	    if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+	    if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
 		/* Backward compatibility mode: */
 		o->op_private |= OPpENTERSUB_INARGS;
 		break;
@@ -1332,18 +1397,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    if (kid->op_type == OP_METHOD_NAMED
 			|| kid->op_type == OP_METHOD)
 		    {
-			OP *newop;
+			UNOP *newop;
 
 			if (kid->op_sibling || kid->op_next != kid) {
 			    yyerror("panic: unexpected optree near method call");
 			    break;
 			}
 			
-			NewOp(1101, newop, 1, OP);
+			NewOp(1101, newop, 1, UNOP);
 			newop->op_type = OP_RV2CV;
 			newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
-			newop->op_next = newop;
-			kid->op_sibling = newop;
+			newop->op_first = Nullop;
+                        newop->op_next = (OP*)newop;
+			kid->op_sibling = (OP*)newop;
 			newop->op_private |= OPpLVAL_INTRO;
 			break;
 		    }
@@ -1382,7 +1448,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    break;
 		}
 		
-		cv = GvCV(kGVOP);
+		cv = GvCV(kGVOP_gv);
 		if (!cv) 
 		    goto restore_2cv;
 		if (CvLVALUE(cv))
@@ -1650,7 +1716,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_ENTERSUB:
-	if ((type == OP_DEFINED || type == OP_LOCK) &&
+	if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
 	    !(o->op_flags & OPf_STACKED)) {
 	    o->op_type = OP_RV2CV;             /* entersub => rv2cv */
 	    o->op_ppaddr = PL_ppaddr[OP_RV2CV];
@@ -1755,7 +1821,6 @@ S_dup_attrlist(pTHX_ OP *o)
 STATIC void
 S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
-    OP *modname;	/* for 'use' */
     SV *stashsv;
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
@@ -1765,19 +1830,18 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 	stashsv = newSVpv(HvNAME(stash), 0);
     else
 	stashsv = &PL_sv_no;
+
 #define ATTRSMODULE "attributes"
-    modname = newSVOP(OP_CONST, 0,
-		      newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
-    modname->op_private |= OPpCONST_BARE;
-    /* that flag is required to make 'use' work right */
-    utilize(1, start_subparse(FALSE, 0),
-	    Nullop, /* version */
-	    modname,
-	    prepend_elem(OP_LIST,
-			 newSVOP(OP_CONST, 0, stashsv),
-			 prepend_elem(OP_LIST,
-				      newSVOP(OP_CONST, 0, newRV(target)),
-				      dup_attrlist(attrs))));
+
+    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;
 }
 
@@ -1799,13 +1863,16 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
     } else if (type == OP_RV2SV ||	/* "our" declaration */
 	       type == OP_RV2AV ||
 	       type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+	o->op_private |= OPpOUR_INTRO;
 	return o;
     } else if (type != OP_PADSV &&
 	     type != OP_PADAV &&
 	     type != OP_PADHV &&
 	     type != OP_PUSHMARK)
     {
-	yyerror(Perl_form(aTHX_ "Can't declare %s in my", PL_op_desc[o->op_type]));
+	yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
+			  PL_op_desc[o->op_type],
+			  PL_in_my == KEY_our ? "our" : "my"));
 	return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
@@ -1813,6 +1880,9 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 	SV *padsv;
 	SV **namesvp;
 
+	PL_in_my = FALSE;
+	PL_in_my_stash = Nullhv;
+
 	/* check for C<my Dog $spot> when deciding package */
 	namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
 	if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
@@ -1832,11 +1902,12 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 {
     if (o->op_flags & OPf_PARENS)
 	list(o);
-    PL_in_my = FALSE;
-    PL_in_my_stash = Nullhv;
     if (attrs)
 	SAVEFREEOP(attrs);
-    return my_kid(o, attrs);
+    o = my_kid(o, attrs);
+    PL_in_my = FALSE;
+    PL_in_my_stash = Nullhv;
+    return o;
 }
 
 OP *
@@ -1859,7 +1930,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     dTHR;
     OP *o;
 
-    if (ckWARN(WARN_UNSAFE) &&
+    if (ckWARN(WARN_MISC) &&
       (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
@@ -1870,7 +1941,7 @@ 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_UNSAFE,
+      Perl_warner(aTHX_ WARN_MISC,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
     }
@@ -1944,12 +2015,11 @@ Perl_block_start(pTHX_ int full)
     int retval = PL_savestack_ix;
 
     SAVEI32(PL_comppad_name_floor);
-    if (full) {
-	if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
-	    PL_comppad_name_floor = PL_comppad_name_fill;
-	else
-	    PL_comppad_name_floor = 0;
-    }
+    PL_comppad_name_floor = AvFILLp(PL_comppad_name);
+    if (full)
+	PL_comppad_name_fill = PL_comppad_name_floor;
+    if (PL_comppad_name_floor < 0)
+	PL_comppad_name_floor = 0;
     SAVEI32(PL_min_intro_pending);
     SAVEI32(PL_max_intro_pending);
     PL_min_intro_pending = 0;
@@ -1959,13 +2029,11 @@ Perl_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVEPPTR(PL_compiling.cop_warnings); 
+    SAVESPTR(PL_compiling.cop_warnings); 
     if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
     }
-
-
     return retval;
 }
 
@@ -2050,16 +2118,18 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 	    char *s;
 	    for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
 	    if (*s == ';' || *s == '=')
-		Perl_warner(aTHX_ WARN_PARENTHESIS, "Parentheses missing around \"%s\" list",
-				lex ? "my" : "local");
+		Perl_warner(aTHX_ WARN_PARENTHESIS,
+			    "Parentheses missing around \"%s\" list",
+			    lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
 	}
     }
-    PL_in_my = FALSE;
-    PL_in_my_stash = Nullhv;
     if (lex)
-	return my(o);
+	o = my(o);
     else
-	return mod(o, OP_NULL);		/* a bit kludgey */
+	o = mod(o, OP_NULL);		/* a bit kludgey */
+    PL_in_my = FALSE;
+    PL_in_my_stash = Nullhv;
+    return o;
 }
 
 OP *
@@ -2209,6 +2279,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
+    peep(curop);
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
@@ -2267,8 +2338,11 @@ Perl_append_elem(pTHX_ I32 type, OP *first, OP *last)
     if (!last)
 	return first;
 
-    if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
-	    return newLISTOP(type, 0, first, last);
+    if (first->op_type != type
+	|| (type == OP_LIST && (first->op_flags & OPf_PARENS)))
+    {
+	return newLISTOP(type, 0, first, last);
+    }
 
     if (first->op_flags & OPf_KIDS)
 	((LISTOP*)first)->op_last->op_sibling = last;
@@ -2514,12 +2588,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	I32 grows = 0;
 	I32 havefinal = 0;
 	U32 final;
-	HV *hv;
 	I32 from_utf	= o->op_private & OPpTRANS_FROM_UTF;
 	I32 to_utf	= o->op_private & OPpTRANS_TO_UTF;
 
 	if (complement) {
-	    U8 tmpbuf[10];
+	    U8 tmpbuf[UTF8_MAXLEN];
 	    U8** cp;
 	    UV nextmin = 0;
 	    New(1109, cp, tlen, U8*);
@@ -2621,15 +2694,19 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	    if (rfirst == 0xffffffff) {
 		diff = tdiff;	/* oops, pretend rdiff is infinite */
 		if (diff > 0)
-		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\tXXXX\n",
+				   (long)tfirst, (long)tlast);
 		else
-		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t\tXXXX\n", tfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\tXXXX\n", (long)tfirst);
 	    }
 	    else {
 		if (diff > 0)
-		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\t%04lx\n",
+				   (long)tfirst, (long)(tfirst + diff),
+				   (long)rfirst);
 		else
-		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t\t%04x\n", tfirst, rfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\t%04lx\n",
+				   (long)tfirst, (long)rfirst);
 
 		if (rfirst + diff > max)
 		    max = rfirst + diff;
@@ -2776,12 +2853,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	    p = SvPV(pat, plen);
 	    pm->op_pmflags |= PMf_SKIPWHITE;
 	}
+	if ((PL_hints & HINT_UTF8) || (SvUTF8(pat) && !(PL_hints & HINT_BYTE)))
+	    pm->op_pmdynflags |= PMdf_UTF8;
 	pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
 	if (strEQ("\\s+", pm->op_pmregexp->precomp))
 	    pm->op_pmflags |= PMf_WHITE;
 	op_free(expr);
     }
     else {
+	if (PL_hints & HINT_UTF8)
+	    pm->op_pmdynflags |= PMdf_UTF8;
 	if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
 	    expr = newUNOP((!(PL_hints & HINT_RE_EVAL) 
 			    ? OP_REGCRESET
@@ -2840,7 +2921,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 		    }
 #else
 		    if (curop->op_type == OP_GV) {
-			GV *gv = cGVOPx(curop);
+			GV *gv = cGVOPx_gv(curop);
 			repl_has_vars = 1;
 			if (strchr("&`'123456789+", *GvENAME(gv)))
 			    break;
@@ -2928,7 +3009,9 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
     padop->op_type = 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;
     if (PL_opargs[type] & OA_RETSCALAR)
@@ -2997,7 +3080,6 @@ void
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
-    OP *meth;
     OP *rqop;
     OP *imop;
     OP *veop;
@@ -3008,45 +3090,55 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 
     veop = Nullop;
 
-    if(version != Nullop) {
+    if (version != Nullop) {
 	SV *vesv = ((SVOP*)version)->op_sv;
 
-	if (arg == Nullop && !SvNIOK(vesv)) {
+	if (arg == Nullop && !SvNIOKp(vesv)) {
 	    arg = version;
 	}
 	else {
 	    OP *pack;
+	    SV *meth;
 
-	    if (version->op_type != OP_CONST || !SvNIOK(vesv))
+	    if (version->op_type != OP_CONST || !SvNIOKp(vesv))
 		Perl_croak(aTHX_ "Version number must be constant number");
 
 	    /* Make copy of id so we don't free it twice */
 	    pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
 	    /* Fake up a method call to VERSION */
+	    meth = newSVpvn("VERSION",7);
+	    sv_upgrade(meth, SVt_PVIV);
+	    (void)SvIOK_on(meth);
+	    PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
 	    veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
 			    append_elem(OP_LIST,
-			    prepend_elem(OP_LIST, pack, list(version)),
-			    newSVOP(OP_METHOD_NAMED, 0,
-				    newSVpvn("VERSION", 7))));
+					prepend_elem(OP_LIST, pack, list(version)),
+					newSVOP(OP_METHOD_NAMED, 0, meth)));
 	}
     }
 
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
 	imop = arg;		/* no import on explicit () */
-    else if(SvNIOK(((SVOP*)id)->op_sv)) {
+    else if (SvNIOKp(((SVOP*)id)->op_sv)) {
 	imop = Nullop;		/* use 5.0; */
     }
     else {
+	SV *meth;
+
 	/* Make copy of id so we don't free it twice */
 	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);
+	(void)SvIOK_on(meth);
+	PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
 	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
-		    append_elem(OP_LIST,
-			prepend_elem(OP_LIST, pack, list(arg)),
-			newSVOP(OP_METHOD_NAMED, 0,
-				aver ? newSVpvn("import", 6)
-				     : newSVpvn("unimport", 8))));
+		       append_elem(OP_LIST,
+				   prepend_elem(OP_LIST, pack, list(arg)),
+				   newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
     /* Fake up a require, handle override, if any */
@@ -3081,6 +3173,58 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     PL_expect = XSTATE;
 }
 
+void
+Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
+{
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+
+#ifdef PERL_IMPLICIT_CONTEXT
+void
+Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...)
+{
+    dTHX;
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+#endif
+
+void
+Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
+{
+    OP *modname, *veop, *imop;
+
+    modname = newSVOP(OP_CONST, 0, name);
+    modname->op_private |= OPpCONST_BARE;
+    if (ver) {
+	veop = newSVOP(OP_CONST, 0, ver);
+    }
+    else
+	veop = Nullop;
+    if (flags & PERL_LOADMOD_NOIMPORT) {
+	imop = sawparens(newNULLLIST());
+    }
+    else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+	imop = va_arg(*args, OP*);
+    }
+    else {
+	SV *sv;
+	imop = Nullop;
+	sv = va_arg(*args, SV*);
+	while (sv) {
+	    imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+	    sv = va_arg(*args, SV*);
+	}
+    }
+    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+	    veop, modname, imop);
+}
+
 OP *
 Perl_dofile(pTHX_ OP *term)
 {
@@ -3165,6 +3309,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 
     if (list_assignment(left)) {
 	dTHR;
+	OP *curop;
+
 	PL_modcount = 0;
 	PL_eval_start = right;	/* Grandfathering $[ assignment here.  Bletch.*/
 	left = mod(left, OP_AASSIGN);
@@ -3175,18 +3321,25 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	    op_free(right);
 	    return Nullop;
 	}
-	o = newBINOP(OP_AASSIGN, flags,
-		list(force_list(right)),
-		list(force_list(left)) );
+	curop = list(force_list(left));
+	o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
 	o->op_private = 0 | (flags >> 8);
+	for (curop = ((LISTOP*)curop)->op_first;
+	     curop; curop = curop->op_sibling)
+	{
+	    if (curop->op_type == OP_RV2HV &&
+		((UNOP*)curop)->op_first->op_type != OP_GV) {
+		o->op_private |= OPpASSIGN_HASH;
+		break;
+	    }
+	}
 	if (!(left->op_private & OPpLVAL_INTRO)) {
-	    OP *curop;
 	    OP *lastop = o;
 	    PL_generation++;
 	    for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
 		if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
 		    if (curop->op_type == OP_GV) {
-			GV *gv = cGVOPx(curop);
+			GV *gv = cGVOPx_gv(curop);
 			if (gv == PL_defgv || SvCUR(gv) == PL_generation)
 			    break;
 			SvCUR(gv) = PL_generation;
@@ -3224,7 +3377,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		lastop = curop;
 	    }
 	    if (curop != o)
-		o->op_private = OPpASSIGN_COMMON;
+		o->op_private |= OPpASSIGN_COMMON;
 	}
 	if (right && right->op_type == OP_SPLIT) {
 	    OP* tmpop;
@@ -3238,7 +3391,13 @@ 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) {
-			pm->op_pmreplroot = (OP*)cGVOPx(tmpop);
+#ifdef USE_ITHREADS
+			pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+			cPADOPx(tmpop)->op_padix = 0;	/* steal it */
+#else
+			pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+			cSVOPx(tmpop)->op_sv = Nullsv;	/* steal it */
+#endif
 			pm->op_pmflags |= PMf_ONCE;
 			tmpop = cUNOPo->op_first;	/* to list (nulled) */
 			tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
@@ -3300,7 +3459,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = flags;
-    cop->op_private = (PL_hints & HINT_UTF8);
+    cop->op_private = (PL_hints & HINT_BYTE);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -3330,14 +3489,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #else
     CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
 #endif
-    cop->cop_stash = PL_curstash;
+    CopSTASH_set(cop, PL_curstash);
 
     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);
-	    SvIVX(*svp) = 1;
-	    SvSTASH(*svp) = (HV*)cop;
+	    SvIVX(*svp) = PTR2IV(cop);
 	}
     }
 
@@ -3402,9 +3560,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	}
     }
     if (first->op_type == OP_CONST) {
-	if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE))
-	    Perl_warner(aTHX_ WARN_PRECEDENCE, "Probable precedence problem on %s", 
-			PL_op_desc[type]);
+	if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
+	    Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional"); 
 	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
 	    op_free(first);
 	    *firstp = Nullop;
@@ -3422,7 +3579,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	else
 	    scalar(other);
     }
-    else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
+    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
 	OP *k1 = ((UNOP*)first)->op_first;
 	OP *k2 = k1->op_sibling;
 	OPCODE warnop = 0;
@@ -3451,7 +3608,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	if (warnop) {
 	    line_t oldline = CopLINE(PL_curcop);
 	    CopLINE_set(PL_curcop, PL_copline);
-	    Perl_warner(aTHX_ WARN_UNSAFE,
+	    Perl_warner(aTHX_ WARN_MISC,
 		 "Value of %s%s can be \"0\"; test with defined()",
 		 PL_op_desc[warnop],
 		 ((warnop == OP_READLINE || warnop == OP_GLOB)
@@ -3652,6 +3809,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     OP *listop;
     OP *o;
     OP *condop;
+    U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
 		 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
@@ -3680,9 +3838,14 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     if (!block)
 	block = newOP(OP_NULL, 0);
+    else if (cont) {
+	block = scope(block);
+    }
 
-    if (cont)
+    if (cont) {
 	next = LINKLIST(cont);
+	loopflags |= OPpLOOP_CONTINUE;
+    }
     if (expr) {
 	cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
 	if ((line_t)whileline != NOLINE) {
@@ -3725,6 +3888,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     loop->op_redoop = redo;
     loop->op_lastop = o;
+    o->op_private |= loopflags;
 
     if (next)
 	loop->op_nextop = next;
@@ -3740,7 +3904,6 @@ OP *
 Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
 {
     LOOP *loop;
-    LOOP *tmp;
     OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
@@ -3815,9 +3978,12 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 			       append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
 #ifdef PL_OP_SLAB_ALLOC
-    NewOp(1234,tmp,1,LOOP);
-    Copy(loop,tmp,1,LOOP);
-    loop = tmp;
+    {
+	LOOP *tmp;
+	NewOp(1234,tmp,1,LOOP);
+	Copy(loop,tmp,1,LOOP);
+	loop = tmp;
+    }
 #else
     Renew(loop, 1, LOOP);
 #endif 
@@ -3876,7 +4042,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif /* USE_THREADS */
 	ENTER;
 
-	SAVESPTR(PL_curpad);
+	SAVEVPTR(PL_curpad);
 	PL_curpad = 0;
 
 	if (!CvCLONED(cv))
@@ -3913,10 +4079,10 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 }
 
-#ifdef DEBUGGING
 STATIC void
 S_cv_dump(pTHX_ CV *cv)
 {
+#ifdef DEBUGGING
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
     AV* pad_name;
@@ -3951,14 +4117,14 @@ S_cv_dump(pTHX_ CV *cv)
 	if (SvPOK(pname[ix]))
 	    PerlIO_printf(Perl_debug_log,
 			  "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-			  ix, PTR2UV(ppad[ix]),
+			  (int)ix, PTR2UV(ppad[ix]),
 			  SvFAKE(pname[ix]) ? "FAKE " : "",
 			  SvPVX(pname[ix]),
 			  (IV)I_32(SvNVX(pname[ix])),
 			  SvIVX(pname[ix]));
     }
-}
 #endif /* DEBUGGING */
+}
 
 STATIC CV *
 S_cv_clone2(pTHX_ CV *proto, CV *outside)
@@ -3979,16 +4145,14 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     assert(!CvUNIQUE(proto));
 
     ENTER;
-    SAVESPTR(PL_curpad);
-    SAVESPTR(PL_comppad);
+    SAVECOMPPAD();
     SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
 
     cv = PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)cv, SvTYPE(proto));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
     CvCLONED_on(cv);
-    if (CvANON(proto))
-	CvANON_on(cv);
 
 #ifdef USE_THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
@@ -4054,7 +4218,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
 		PL_curpad[ix] = sv;
 	    }
 	}
-	else if (IS_PADGV(ppad[ix])) {
+	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
 	    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
 	}
 	else {
@@ -4099,9 +4263,9 @@ CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
     CV *cv;
-    MUTEX_LOCK(&PL_cred_mutex);		/* XXX create separate mutex */
+    LOCK_CRED_MUTEX;			/* XXX create separate mutex */
     cv = cv_clone2(proto, CvOUTSIDE(proto));
-    MUTEX_UNLOCK(&PL_cred_mutex);	/* XXX create separate mutex */
+    UNLOCK_CRED_MUTEX;			/* XXX create separate mutex */
     return cv;
 }
 
@@ -4110,7 +4274,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
     dTHR;
 
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
 	SV* msg = sv_newmortal();
 	SV* name = Nullsv;
 
@@ -4118,7 +4282,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 	    gv_efullname3(name = sv_newmortal(), gv, Nullch);
 	sv_setpv(msg, "Prototype mismatch:");
 	if (name)
-	    Perl_sv_catpvf(aTHX_ msg, " sub %_", name);
+	    Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
 	if (SvPOK(cv))
 	    Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
 	sv_catpv(msg, " vs ");
@@ -4126,7 +4290,7 @@ 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_UNSAFE, "%_", msg);
+	Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
     }
 }
 
@@ -4143,10 +4307,10 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
     SV *sv = Nullsv;
 
-    if(!o)
+    if (!o)
 	return Nullsv;
  
-    if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
+    if (o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
 	o = cLISTOPo->op_first->op_sibling;
 
     for (; o; o = o->op_next) {
@@ -4160,9 +4324,9 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 	    break;
 	if (sv)
 	    return Nullsv;
-	if (type == OP_CONST)
+	if (type == OP_CONST && cSVOPo->op_sv)
 	    sv = cSVOPo->op_sv;
-	else if (type == OP_PADSV && cv) {
+	else if ((type == OP_PADSV || type == OP_CONST) && cv) {
 	    AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
 	    sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
 	    if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
@@ -4201,14 +4365,26 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dTHR;
     STRLEN n_a;
-    char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
-    GV *gv = gv_fetchpv(name ? name : "__ANON__",
-			GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-			SVt_PVCV);
+    char *name;
+    char *aname;
+    GV *gv;
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
+    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"]",
+		       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+	aname = SvPVX(sv);
+    }
+    else
+	aname = Nullch;
+    gv = gv_fetchpv(name ? name : (aname ? aname : "__ANON__"),
+		    GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
+		    SVt_PVCV);
+
     if (o)
 	SAVEFREEOP(o);
     if (proto)
@@ -4220,9 +4396,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 					   maximum a prototype before. */
 	if (SvTYPE(gv) > SVt_NULL) {
 	    if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
-		&& ckWARN_d(WARN_UNSAFE))
+		&& ckWARN_d(WARN_PROTOTYPE))
 	    {
-		Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+		Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
 	    }
 	    cv_ckproto((CV*)gv, NULL, ps);
 	}
@@ -4238,7 +4414,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     if (!name || GvCVGEN(gv))
 	cv = Nullcv;
-    else if (cv = GvCV(gv)) {
+    else if ((cv = GvCV(gv))) {
 	cv_ckproto(cv, gv, ps);
 	/* already defined (or promised)? */
 	if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
@@ -4254,13 +4430,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
 	    if (!block)
 		goto withattrs;
-	    if(const_sv = cv_const_sv(cv))
+	    if ((const_sv = cv_const_sv(cv)))
 		const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
-	    if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE) 
-					&& !(CvGV(cv) && GvSTASH(CvGV(cv))
-					&& HvNAME(GvSTASH(CvGV(cv)))
-					&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
-						 "autouse"))) {
+	    if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
+	    {
 		line_t oldline = CopLINE(PL_curcop);
 		CopLINE_set(PL_curcop, PL_copline);
 		Perl_warner(aTHX_ WARN_REDEFINE,
@@ -4366,12 +4539,25 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
 	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
+    if (CvLVALUE(cv)) {
+	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
+    }
+    else {
+	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+    }
+    CvROOT(cv)->op_private |= OPpREFCOUNTED;
+    OpREFCNT_set(CvROOT(cv), 1);
+    CvSTART(cv) = LINKLIST(CvROOT(cv));
+    CvROOT(cv)->op_next = 0;
+    peep(CvSTART(cv));
+
+    /* now that optimizer has done its work, adjust pad values */
     if (CvCLONE(cv)) {
 	SV **namep = AvARRAY(PL_comppad_name);
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    SV *namesv;
 
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
 	    /*
 	     * The only things that a clonable function needs in its
@@ -4395,55 +4581,49 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	AvFLAGS(av) = AVf_REIFY;
 
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
 	    if (!SvPADMY(PL_curpad[ix]))
 		SvPADTMP_on(PL_curpad[ix]);
 	}
     }
 
-    if (CvLVALUE(cv)) {
-	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
-    }
-    else {
-	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
-    }
-    CvROOT(cv)->op_private |= OPpREFCOUNTED;
-    OpREFCNT_set(CvROOT(cv), 1);
-    CvSTART(cv) = LINKLIST(CvROOT(cv));
-    CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
-
-    if (name) {
+    if (name || aname) {
 	char *s;
+	char *tname = (name ? name : aname);
 
 	if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
 	    SV *sv = NEWSV(0,0);
 	    SV *tmpstr = sv_newmortal();
 	    GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
-	    CV *cv;
+	    CV *pcv;
 	    HV *hv;
 
-	    Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-			   CopFILESV(PL_curcop),
+	    Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+			   CopFILE(PL_curcop),
 			   (long)PL_subline, (long)CopLINE(PL_curcop));
 	    gv_efullname3(tmpstr, gv, Nullch);
 	    hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
 	    hv = GvHVn(db_postponed);
 	    if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
-		  && (cv = GvCV(db_postponed))) {
+		&& (pcv = GvCV(db_postponed)))
+	    {
 		dSP;
 		PUSHMARK(SP);
 		XPUSHs(tmpstr);
 		PUTBACK;
-		call_sv((SV*)cv, G_DISCARD);
+		call_sv((SV*)pcv, G_DISCARD);
 	    }
 	}
 
-	if ((s = strrchr(name,':')))
+	if ((s = strrchr(tname,':')))
 	    s++;
 	else
-	    s = name;
+	    s = tname;
+
+	if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
+	    goto done;
+
 	if (strEQ(s, "BEGIN")) {
 	    I32 oldscope = PL_scopestack_ix;
 	    ENTER;
@@ -4455,7 +4635,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    if (!PL_beginav)
 		PL_beginav = newAV();
 	    DEBUG_x( dump_sub(gv) );
-	    av_push(PL_beginav, (SV *)cv);
+	    av_push(PL_beginav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	    call_list(oldscope, PL_beginav);
 
@@ -4466,20 +4646,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	else if (strEQ(s, "END") && !PL_error_count) {
 	    if (!PL_endav)
 		PL_endav = newAV();
+	    DEBUG_x( dump_sub(gv) );
 	    av_unshift(PL_endav, 1);
-	    av_store(PL_endav, 0, (SV *)cv);
+	    av_store(PL_endav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
-	else if (strEQ(s, "STOP") && !PL_error_count) {
-	    if (!PL_stopav)
-		PL_stopav = newAV();
-	    av_unshift(PL_stopav, 1);
-	    av_store(PL_stopav, 0, (SV *)cv);
+	else if (strEQ(s, "CHECK") && !PL_error_count) {
+	    if (!PL_checkav)
+		PL_checkav = newAV();
+	    DEBUG_x( dump_sub(gv) );
+	    av_unshift(PL_checkav, 1);
+	    av_store(PL_checkav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "INIT") && !PL_error_count) {
 	    if (!PL_initav)
 		PL_initav = newAV();
+	    DEBUG_x( dump_sub(gv) );
 	    av_push(PL_initav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
@@ -4492,19 +4675,37 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 }
 
 /* XXX unsafe for threads if eval_owner isn't held */
+/*
+=for apidoc newCONSTSUB
+
+Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
+eligible for inlining at compile-time.
+
+=cut
+*/
+
 void
 Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 {
     dTHR;
-    U32 oldhints = PL_hints;
-    HV *old_cop_stash = PL_curcop->cop_stash;
-    HV *old_curstash = PL_curstash;
-    line_t oldline = CopLINE(PL_curcop);
-    CopLINE_set(PL_curcop, PL_copline);
 
+    ENTER;
+    SAVECOPLINE(PL_curcop);
+    SAVEHINTS();
+
+    CopLINE_set(PL_curcop, PL_copline);
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    if(stash)
-	PL_curstash = PL_curcop->cop_stash = stash;
+
+    if (stash) {
+	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
+    }
 
     newATTRSUB(
 	start_subparse(FALSE, 0),
@@ -4514,12 +4715,17 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
     );
 
-    PL_hints = oldhints;
-    PL_curcop->cop_stash = old_cop_stash;
-    PL_curstash = old_curstash;
-    CopLINE_set(PL_curcop, oldline);
+    LEAVE;
 }
 
+/*
+=for apidoc U||newXS
+
+Used by C<xsubpp> to hook up XSUBs as Perl subs.
+
+=cut
+*/
+
 CV *
 Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 {
@@ -4527,7 +4733,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
-    if (cv = (name ? GvCV(gv) : Nullcv)) {
+    if ((cv = (name ? GvCV(gv) : Nullcv))) {
 	if (GvCVGEN(gv)) {
 	    /* just a cached method */
 	    SvREFCNT_dec(cv);
@@ -4577,36 +4783,41 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	    s++;
 	else
 	    s = name;
+
+	if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
+	    goto done;
+
 	if (strEQ(s, "BEGIN")) {
 	    if (!PL_beginav)
 		PL_beginav = newAV();
-	    av_push(PL_beginav, (SV *)cv);
+	    av_push(PL_beginav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "END")) {
 	    if (!PL_endav)
 		PL_endav = newAV();
 	    av_unshift(PL_endav, 1);
-	    av_store(PL_endav, 0, (SV *)cv);
+	    av_store(PL_endav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
-	else if (strEQ(s, "STOP")) {
-	    if (!PL_stopav)
-		PL_stopav = newAV();
-	    av_unshift(PL_stopav, 1);
-	    av_store(PL_stopav, 0, (SV *)cv);
+	else if (strEQ(s, "CHECK")) {
+	    if (!PL_checkav)
+		PL_checkav = newAV();
+	    av_unshift(PL_checkav, 1);
+	    av_store(PL_checkav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "INIT")) {
 	    if (!PL_initav)
 		PL_initav = newAV();
-	    av_push(PL_initav, (SV *)cv);
+	    av_push(PL_initav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
     }
     else
 	CvANON_on(cv);
 
+done:
     return cv;
 }
 
@@ -4626,7 +4837,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 	name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
     GvMULTI_on(gv);
-    if (cv = GvFORM(gv)) {
+    if ((cv = GvFORM(gv))) {
 	if (ckWARN(WARN_REDEFINE)) {
 	    line_t oldline = CopLINE(PL_curcop);
 
@@ -4863,11 +5074,22 @@ Perl_ck_delete(pTHX_ OP *o)
     o->op_private = 0;
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type == OP_HSLICE)
+	switch (kid->op_type) {
+	case OP_ASLICE:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HSLICE:
 	    o->op_private |= OPpSLICE;
-	else if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element or slice",
+	    break;
+	case OP_AELEM:
+	    o->op_flags |= OPf_SPECIAL;
+	    /* FALL THROUGH */
+	case OP_HELEM:
+	    break;
+	default:
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
 		  PL_op_desc[o->op_type]);
+	}
 	null(kid);
     }
     return o;
@@ -4953,8 +5175,18 @@ Perl_ck_exists(pTHX_ OP *o)
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
-	if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]);
+	if (kid->op_type == OP_ENTERSUB) {
+	    (void) ref(kid, o->op_type);
+	    if (kid->op_type != OP_RV2CV && !PL_error_count)
+		Perl_croak(aTHX_ "%s argument is not a subroutine name",
+			   PL_op_desc[o->op_type]);
+	    o->op_private |= OPpEXISTS_SUB;
+	}
+	else if (kid->op_type == OP_AELEM)
+	    o->op_flags |= OPf_SPECIAL;
+	else if (kid->op_type != OP_HELEM)
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+		       PL_op_desc[o->op_type]);
 	null(kid);
     }
     return o;
@@ -5067,7 +5299,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 	    kid->op_type = OP_GV;
 	    SvREFCNT_dec(kid->op_sv);
 #ifdef USE_ITHREADS
-	    /* XXXXXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+	    /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
 	    kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
 	    GvIN_PAD_on(gv);
 	    PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
@@ -5086,10 +5318,10 @@ Perl_ck_ftst(pTHX_ OP *o)
     dTHR;
     I32 type = o->op_type;
 
-    if (o->op_flags & OPf_REF)
-	return o;
-
-    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+    if (o->op_flags & OPf_REF) {
+	/* nothing */
+    }
+    else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
 
 	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
@@ -5097,17 +5329,24 @@ Perl_ck_ftst(pTHX_ OP *o)
 	    OP *newop = newGVOP(type, OPf_REF,
 		gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
 	    op_free(o);
-	    return newop;
+	    o = newop;
 	}
     }
     else {
 	op_free(o);
 	if (type == OP_FTTTY)
-           return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
 				SVt_PVIO));
 	else
-	    return newUNOP(type, 0, newDEFSVOP());
+	    o = newUNOP(type, 0, newDEFSVOP());
+    }
+#ifdef USE_LOCALE
+    if (type == OP_FTTEXT || type == OP_FTBINARY) {
+	o->op_private = 0;
+	if (PL_hints & HINT_LOCALE)
+	    o->op_private |= OPpLOCALE;
     }
+#endif
     return o;
 }
 
@@ -5134,7 +5373,7 @@ Perl_ck_fun(pTHX_ OP *o)
 	tokid = &cLISTOPo->op_first;
 	kid = cLISTOPo->op_first;
 	if (kid->op_type == OP_PUSHMARK ||
-	    kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
+	    (kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK))
 	{
 	    tokid = &kid->op_sibling;
 	    kid = kid->op_sibling;
@@ -5170,8 +5409,8 @@ Perl_ck_fun(pTHX_ OP *o)
 		    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_SYNTAX))
-			Perl_warner(aTHX_ WARN_SYNTAX,
+		    if (ckWARN(WARN_DEPRECATED))
+			Perl_warner(aTHX_ WARN_DEPRECATED,
 			    "Array @%s missing the @ in argument %"IVdf" of %s()",
 			    name, (IV)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -5190,8 +5429,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_SYNTAX))
-			Perl_warner(aTHX_ WARN_SYNTAX,
+		    if (ckWARN(WARN_DEPRECATED))
+			Perl_warner(aTHX_ WARN_DEPRECATED,
 			    "Hash %%%s missing the %% in argument %"IVdf" of %s()",
 			    name, (IV)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -5232,26 +5471,46 @@ Perl_ck_fun(pTHX_ OP *o)
 		    else {
 			I32 flags = OPf_SPECIAL;
 			I32 priv = 0;
+			PADOFFSET targ = 0;
+
 			/* is this op a FH constructor? */
 			if (is_handle_constructor(o,numargs)) {
-			    flags   = 0;                         
-			    /* Set a flag to tell rv2gv to vivify 
+			    char *name = Nullch;
+			    STRLEN len;
+
+			    flags = 0;
+			    /* Set a flag to tell rv2gv to vivify
 			     * need to "prove" flag does not mean something
 			     * else already - NI-S 1999/05/07
-			     */ 
-			    priv = OPpDEREF; 
-#if 0
-			    /* Helps with open($array[$n],...) 
-			       but is too simplistic - need to do selectively
-			    */
-			    mod(kid,type);
-#endif
+			     */
+			    priv = OPpDEREF;
+			    if (kid->op_type == OP_PADSV) {
+				SV **namep = av_fetch(PL_comppad_name,
+						      kid->op_targ, 4);
+				if (namep && *namep)
+				    name = SvPV(*namep, len);
+			    }
+			    else if (kid->op_type == OP_RV2SV
+				     && kUNOP->op_first->op_type == OP_GV)
+			    {
+				GV *gv = cGVOPx_gv(kUNOP->op_first);
+				name = GvNAME(gv);
+				len = GvNAMELEN(gv);
+			    }
+			    if (name) {
+				SV *namesv;
+				targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+				namesv = PL_curpad[targ];
+				(void)SvUPGRADE(namesv, SVt_PV);
+				if (*name != '$')
+				    sv_setpvn(namesv, "$", 1);
+				sv_catpvn(namesv, name, len);
+			    }
 			}
 			kid->op_sibling = 0;
 			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
-			if (priv) {
-			    kid->op_private |= priv;
-			}
+			kid->op_targ = targ;
+			kid->op_private |= priv;
 		    }
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -5290,24 +5549,24 @@ Perl_ck_glob(pTHX_ OP *o)
 {
     GV *gv;
 
+    o = ck_fun(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)))
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
-#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+#if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
-	OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
-	modname->op_private |= OPpCONST_BARE;
 	ENTER;
-	utilize(1, start_subparse(FALSE, 0), Nullop, modname,
-		newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+	Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv,
+			 /* null-terminated import list */
+			 newSVpvn(":globally", 9), Nullsv);
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 	LEAVE;
     }
-#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+#endif /* PERL_EXTERNAL_GLOB */
 
     if (gv && GvIMPORTED_CV(gv)) {
 	append_elem(OP_GLOB, o,
@@ -5328,7 +5587,7 @@ Perl_ck_glob(pTHX_ OP *o)
     gv_IOadd(gv);
     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
-    return ck_fun(o);
+    return o;
 }
 
 OP *
@@ -5428,7 +5687,7 @@ Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
 	    break;                      /* Globals via GV can be undef */ 
 	case OP_PADHV:
 	    Perl_warner(aTHX_ WARN_DEPRECATED,
-			"defined(%hash) is deprecated");
+			"defined(%%hash) is deprecated");
 	    Perl_warner(aTHX_ WARN_DEPRECATED,
 			"(Maybe you should just omit the defined()?)\n");
 	    break;
@@ -5505,7 +5764,9 @@ Perl_ck_sassign(pTHX_ OP *o)
     OP *kid = cLISTOPo->op_first;
     /* has a disposable target? */
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
-	&& !(kid->op_flags & OPf_STACKED))
+	&& !(kid->op_flags & OPf_STACKED)
+	/* Cannot steal the second time! */
+	&& !(kid->op_private & OPpTARGET_MY))
     {
 	OP *kkid = kid->op_sibling;
 
@@ -5513,31 +5774,6 @@ Perl_ck_sassign(pTHX_ OP *o)
 	if (kkid && kkid->op_type == OP_PADSV
 	    && !(kkid->op_private & OPpLVAL_INTRO))
 	{
-	    /* Concat has problems if target is equal to right arg. */
-	    if (kid->op_type == OP_CONCAT) {
-		if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV
-		    && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
-		    return o;
-	    }
-	    else if (kid->op_type == OP_JOIN) {
-		/* do_join has problems if the arguments coincide with target.
-		   In fact the second argument *can* safely coincide,
-		   but ignore=pessimize this rare occasion. */
-		OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
-
-		while (arg) {
-		    if (arg->op_type == OP_PADSV
-			&& arg->op_targ == kkid->op_targ)
-			return o;
-		    arg = arg->op_sibling;
-		}
-	    }
-	    else if (kid->op_type == OP_QUOTEMETA) {
-		/* quotemeta has problems if the argument coincides with target. */
-		if (kLISTOP->op_first->op_type == OP_PADSV
-		    && kLISTOP->op_first->op_targ == kkid->op_targ)
-		    return o;
-	    }
 	    kid->op_targ = kkid->op_targ;
 	    kkid->op_targ = 0;
 	    /* Now we do not need PADSV and SASSIGN. */
@@ -5579,8 +5815,8 @@ Perl_ck_method(pTHX_ OP *o)
 	SV* sv = kSVOP->op_sv;
 	if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
 	    OP *cmop;
-	    sv_upgrade(sv, SVt_PVIV);
-	    SvIOK_on(sv);
+	    (void)SvUPGRADE(sv, SVt_PVIV);
+	    (void)SvIOK_on(sv);
 	    PERL_HASH(SvUVX(sv), SvPVX(sv), SvCUR(sv));
 	    cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
 	    kSVOP->op_sv = Nullsv;
@@ -5598,6 +5834,36 @@ Perl_ck_null(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_open(pTHX_ OP *o)
+{
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+	SV **svp;
+	I32 mode;
+	svp = hv_fetch(table, "open_IN", 7, FALSE);
+	if (svp && *svp) {
+	    mode = mode_from_discipline(*svp);
+	    if (mode & O_BINARY)
+		o->op_private |= OPpOPEN_IN_RAW;
+	    else if (mode & O_TEXT)
+		o->op_private |= OPpOPEN_IN_CRLF;
+	}
+
+	svp = hv_fetch(table, "open_OUT", 8, FALSE);
+	if (svp && *svp) {
+	    mode = mode_from_discipline(*svp);
+	    if (mode & O_BINARY)
+		o->op_private |= OPpOPEN_OUT_RAW;
+	    else if (mode & O_TEXT)
+		o->op_private |= OPpOPEN_OUT_CRLF;
+	}
+    }
+    if (o->op_type == OP_BACKTICK)
+	return o;
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
@@ -5624,7 +5890,13 @@ Perl_ck_require(pTHX_ OP *o)
 		    --SvCUR(kid->op_sv);
 		}
 	    }
-	    sv_catpvn(kid->op_sv, ".pm", 3);
+	    if (SvREADONLY(kid->op_sv)) {
+		SvREADONLY_off(kid->op_sv);
+		sv_catpvn(kid->op_sv, ".pm", 3);
+		SvREADONLY_on(kid->op_sv);
+	    }
+	    else
+		sv_catpvn(kid->op_sv, ".pm", 3);
 	}
     }
     return ck_fun(o);
@@ -5772,12 +6044,12 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
 	return;
     kid = kUNOP->op_first;				/* get past rv2sv */
-    gv = kGVOP;
+    gv = kGVOP_gv;
     if (GvSTASH(gv) != PL_curstash)
 	return;
     if (strEQ(GvNAME(gv), "a"))
 	reversed = 0;
-    else if(strEQ(GvNAME(gv), "b"))
+    else if (strEQ(GvNAME(gv), "b"))
 	reversed = 1;
     else
 	return;
@@ -5788,7 +6060,7 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
 	return;
     kid = kUNOP->op_first;				/* get past rv2sv */
-    gv = kGVOP;
+    gv = kGVOP_gv;
     if (GvSTASH(gv) != PL_curstash
 	|| ( reversed
 	    ? strNE(GvNAME(gv), "a")
@@ -5898,7 +6170,7 @@ Perl_ck_subr(pTHX_ OP *o)
 	null(cvop);		/* disable rv2cv */
 	tmpop = (SVOP*)((UNOP*)cvop)->op_first;
 	if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
-	    GV *gv = cGVOPx(tmpop);
+	    GV *gv = cGVOPx_gv(tmpop);
 	    cv = GvCVu(gv);
 	    if (!cv)
 		tmpop->op_private |= OPpEARLY_CV;
@@ -5966,7 +6238,7 @@ Perl_ck_subr(pTHX_ OP *o)
 				(gvop = ((UNOP*)gvop)->op_first) &&
 				gvop->op_type == OP_GV)
 			    {
-				GV *gv = cGVOPx(gvop);
+				GV *gv = cGVOPx_gv(gvop);
 				OP *sibling = o2->op_sibling;
 				SV *n = newSVpvn("",0);
 				op_free(o2);
@@ -6084,7 +6356,7 @@ Perl_peep(pTHX_ register OP *o)
 	return;
     ENTER;
     SAVEOP();
-    SAVESPTR(PL_curcop);
+    SAVEVPTR(PL_curcop);
     for (; o; o = o->op_next) {
 	if (o->op_seq)
 	    break;
@@ -6103,32 +6375,29 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_CONST:
 	    if (cSVOPo->op_private & OPpCONST_STRICT)
 		no_bareword_allowed(o);
-	    /* FALL THROUGH */
-	case OP_UC:
-	case OP_UCFIRST:
-	case OP_LC:
-	case OP_LCFIRST:
-	    if ( o->op_next && o->op_next->op_type == OP_STRINGIFY
-		 && !(o->op_next->op_private & OPpTARGET_MY) )
-		null(o->op_next);
+#ifdef USE_ITHREADS
+	    /* Relocate sv to the pad for thread safety.
+	     * Despite being a "constant", the SV is written to,
+	     * for reference counts, sv_upgrade() etc. */
+	    if (cSVOP->op_sv) {
+		PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+		SvREFCNT_dec(PL_curpad[ix]);
+		SvPADTMP_on(cSVOPo->op_sv);
+		PL_curpad[ix] = cSVOPo->op_sv;
+		cSVOPo->op_sv = Nullsv;
+		o->op_targ = ix;
+	    }
+#endif
 	    o->op_seq = PL_op_seqmax++;
 	    break;
+
 	case OP_CONCAT:
-	case OP_JOIN:
-	case OP_QUOTEMETA:
 	    if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
 		if (o->op_next->op_private & OPpTARGET_MY) {
-		    if ((o->op_flags & OPf_STACKED) /* chained concats */
-			|| (o->op_type == OP_CONCAT
-	    /* Concat has problems if target is equal to right arg. */
-			    && (((LISTOP*)o)->op_first->op_sibling->op_type
-				== OP_PADSV)
-			    && (((LISTOP*)o)->op_first->op_sibling->op_targ
-				== o->op_next->op_targ)))
-		    {
+		    if (o->op_flags & OPf_STACKED) /* chained concats */
 			goto ignore_optimization;
-		    }
 		    else {
+			/* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
 			o->op_targ = o->op_next->op_targ;
 			o->op_next->op_targ = 0;
 			o->op_private |= OPpTARGET_MY;
@@ -6168,7 +6437,8 @@ Perl_peep(pTHX_ register OP *o)
 	    if (o->op_next->op_type == OP_RV2SV) {
 		if (!(o->op_next->op_private & OPpDEREF)) {
 		    null(o->op_next);
-		    o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
+		    o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
+							       | OPpOUR_INTRO);
 		    o->op_next = o->op_next->op_next;
 		    o->op_type = OP_GVSV;
 		    o->op_ppaddr = PL_ppaddr[OP_GVSV];
@@ -6195,17 +6465,17 @@ Perl_peep(pTHX_ register OP *o)
 		    o->op_type = OP_AELEMFAST;
 		    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
 		    o->op_private = (U8)i;
-		    gv = cGVOPo;
+		    gv = cGVOPo_gv;
 		    GvAVn(gv);
 		}
 	    }
-	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
-		GV *gv = cGVOPo;
+	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
+		GV *gv = cGVOPo_gv;
 		if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
 		    /* XXX could check prototype here instead of just carping */
 		    SV *sv = sv_newmortal();
 		    gv_efullname3(sv, gv, Nullch);
-		    Perl_warner(aTHX_ WARN_UNSAFE,
+		    Perl_warner(aTHX_ WARN_PROTOTYPE,
 				"%s() called too early to check prototype",
 				SvPV_nolen(sv));
 		}
@@ -6253,8 +6523,10 @@ 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_SYNTAX, "Statement unlikely to be reached");
-		    Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
+		    Perl_warner(aTHX_ WARN_EXEC,
+				"Statement unlikely to be reached");
+		    Perl_warner(aTHX_ WARN_EXEC,
+				"(Maybe you meant system() when you said exec()?)\n");
 		    CopLINE_set(PL_curcop, oldline);
 		}
 	    }
@@ -6264,11 +6536,12 @@ Perl_peep(pTHX_ register OP *o)
 	    UNOP *rop;
 	    SV *lexname;
 	    GV **fields;
-	    SV **svp, **indsvp;
+	    SV **svp, **indsvp, *sv;
 	    I32 ind;
 	    char *key;
 	    STRLEN keylen;
 	
+	    o->op_seq = PL_op_seqmax++;
 	    if ((o->op_private & (OPpLVAL_INTRO))
 		|| ((BINOP*)o)->op_last->op_type != OP_CONST)
 		break;
@@ -6281,7 +6554,7 @@ Perl_peep(pTHX_ register OP *o)
 	    fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
 	    if (!fields || !GvHV(*fields))
 		break;
-	    svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+	    svp = cSVOPx_svp(((BINOP*)o)->op_last);
 	    key = SvPV(*svp, keylen);
 	    indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
 	    if (!indsvp) {
@@ -6295,8 +6568,76 @@ Perl_peep(pTHX_ register OP *o)
 	    rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
 	    o->op_type = OP_AELEM;
 	    o->op_ppaddr = PL_ppaddr[OP_AELEM];
+	    sv = newSViv(ind);
+	    if (SvREADONLY(*svp))
+		SvREADONLY_on(sv);
+	    SvFLAGS(sv) |= (SvFLAGS(*svp)
+			    & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY));
 	    SvREFCNT_dec(*svp);
-	    *svp = newSViv(ind);
+	    *svp = sv;
+	    break;
+	}
+	
+	case OP_HSLICE: {
+	    UNOP *rop;
+	    SV *lexname;
+	    GV **fields;
+	    SV **svp, **indsvp, *sv;
+	    I32 ind;
+	    char *key;
+	    STRLEN keylen;
+	    SVOP *first_key_op, *key_op;
+
+	    o->op_seq = PL_op_seqmax++;
+	    if ((o->op_private & (OPpLVAL_INTRO))
+		/* I bet there's always a pushmark... */
+		|| ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST)
+		/* hmmm, no optimization if list contains only one key. */
+		break;
+	    rop = (UNOP*)((LISTOP*)o)->op_last;
+	    if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+		break;
+	    lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
+	    if (!SvOBJECT(lexname))
+		break;
+	    fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+	    if (!fields || !GvHV(*fields))
+		break;
+	    /* Again guessing that the pushmark can be jumped over.... */
+	    first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling)
+		->op_first->op_sibling;
+	    /* Check that the key list contains only constants. */
+	    for (key_op = first_key_op; key_op;
+		 key_op = (SVOP*)key_op->op_sibling)
+		if (key_op->op_type != OP_CONST)
+		    break;
+	    if (key_op)
+		break;
+	    rop->op_type = OP_RV2AV;
+	    rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
+	    o->op_type = OP_ASLICE;
+	    o->op_ppaddr = PL_ppaddr[OP_ASLICE];
+	    for (key_op = first_key_op; key_op;
+		 key_op = (SVOP*)key_op->op_sibling) {
+		svp = cSVOPx_svp(key_op);
+		key = SvPV(*svp, keylen);
+		indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+		if (!indsvp) {
+		    Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
+			       "in variable %s of type %s",
+			  key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
+		}
+		ind = SvIV(*indsvp);
+		if (ind < 1)
+		    Perl_croak(aTHX_ "Bad index while coercing array into hash");
+		sv = newSViv(ind);
+		if (SvREADONLY(*svp))
+		    SvREADONLY_on(sv);
+		SvFLAGS(sv) |= (SvFLAGS(*svp)
+				& (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY));
+		SvREFCNT_dec(*svp);
+		*svp = sv;
+	    }
 	    break;
 	}