X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=eba48b9207f1a5400103234d0dfbd4d783012915;hb=6e9d10810a2ec27ec94fd014e5dbab341c35afb1;hp=59643e78b121cc32e2bcc99211d7905d04368d23;hpb=2b9d42f0ba1bb562fe21327dc7948ab1a5397a19;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 59643e7..eba48b9 100644
--- a/op.c
+++ b/op.c
@@ -20,6 +20,8 @@
 #include "perl.h"
 #include "keywords.h"
 
+#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
+
 /* #define PL_OP_SLAB_ALLOC */
 
 #ifdef PL_OP_SLAB_ALLOC
@@ -70,7 +72,7 @@ STATIC OP *
 S_no_fh_allowed(pTHX_ OP *o)
 {
     yyerror(Perl_form(aTHX_ "Missing comma after first argument to %s function",
-		 PL_op_desc[o->op_type]));
+		 OP_DESC(o)));
     return o;
 }
 
@@ -92,7 +94,7 @@ STATIC void
 S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid)
 {
     yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
-		 (int)n, name, t, PL_op_desc[kid->op_type]));
+		 (int)n, name, t, OP_DESC(kid)));
 }
 
 STATIC void
@@ -103,30 +105,6 @@ S_no_bareword_allowed(pTHX_ OP *o)
 		     SvPV_nolen(cSVOPo_sv)));
 }
 
-STATIC U8*
-S_trlist_upgrade(pTHX_ U8** sp, U8** ep)
-{
-    U8 *s = *sp;
-    U8 *e = *ep;
-    U8 *d;
-
-    Newz(801, d, (e - s) * 2, U8);
-    *sp = d;
-
-    while (s < e) {
-        if (NATIVE_IS_INVARIANT(*s) || NATIVE_TO_UTF(*s) == 0xff)
-            *d++ = *s++;
-	else {
-	    U8 c = NATIVE_TO_ASCII(*s++);
-	    *d++ = UTF8_EIGHT_BIT_HI(c);
-	    *d++ = UTF8_EIGHT_BIT_LO(c);
-        }
-    }
-    *ep = d;
-    return *sp;
-}
-
-
 /* "register" allocation */
 
 PADOFFSET
@@ -137,7 +115,7 @@ Perl_pad_allocmy(pTHX_ char *name)
 
     if (!(PL_in_my == KEY_our ||
 	  isALPHA(name[1]) ||
-	  (PL_hints & HINT_UTF8 && UTF8_IS_START(name[1])) ||
+	  (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
 	  (name[1] == '_' && (int)strlen(name) > 2)))
     {
 	if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
@@ -207,10 +185,9 @@ Perl_pad_allocmy(pTHX_ char *name)
 	if (*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);
+	SvFLAGS(sv) |= SVpad_TYPED;
 	(void)SvUPGRADE(sv, SVt_PVMG);
 	SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
-	PL_sv_objcount++;
     }
     if (PL_in_my == KEY_our) {
 	(void)SvUPGRADE(sv, SVt_PVGV);
@@ -247,11 +224,10 @@ S_pad_addlex(pTHX_ SV *proto_namesv)
 	(void)SvUPGRADE(namesv, SVt_PVGV);
 	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
     }
-    if (SvOBJECT(proto_namesv)) {		/* A typed var */
-	SvOBJECT_on(namesv);
+    if (SvFLAGS(proto_namesv) & SVpad_TYPED) {	/* A typed lexical */
+	SvFLAGS(namesv) |= SVpad_TYPED;
 	(void)SvUPGRADE(namesv, SVt_PVMG);
 	SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
-	PL_sv_objcount++;
     }
     return newoff;
 }
@@ -372,15 +348,24 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 	switch (CxTYPE(cx)) {
 	default:
 	    if (i == 0 && saweval) {
-		seq = cxstack[saweval].blk_oldcop->cop_seq;
 		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
 	    }
 	    break;
 	case CXt_EVAL:
 	    switch (cx->blk_eval.old_op_type) {
 	    case OP_ENTEREVAL:
-		if (CxREALEVAL(cx))
+		if (CxREALEVAL(cx)) {
+		    PADOFFSET off;
 		    saweval = i;
+		    seq = cxstack[i].blk_oldcop->cop_seq;
+		    startcv = cxstack[i].blk_eval.cv;
+		    if (startcv && CvOUTSIDE(startcv)) {
+			off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
+					  i-1, saweval, 0);
+			if (off)	/* continue looking if not found here */
+			    return off;
+		    }
+		}
 		break;
 	    case OP_DOFILE:
 	    case OP_REQUIRE:
@@ -395,9 +380,9 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 	    cv = cx->blk_sub.cv;
 	    if (PL_debstash && CvSTASH(cv) == PL_debstash) {	/* ignore DB'* scope */
 		saweval = i;	/* so we know where we were called from */
+		seq = cxstack[i].blk_oldcop->cop_seq;
 		continue;
 	    }
-	    seq = cxstack[saweval].blk_oldcop->cop_seq;
 	    return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
 	}
     }
@@ -416,7 +401,7 @@ Perl_pad_findmy(pTHX_ char *name)
     PERL_CONTEXT *cx;
     CV *outside;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     /*
      * Special case to get lexical (and hence per-thread) @_.
      * XXX I need to find out how to tell at parse-time whether use
@@ -427,7 +412,7 @@ Perl_pad_findmy(pTHX_ char *name)
      */
     if (strEQ(name, "@_"))
 	return 0;		/* success. (NOT_IN_PAD indicates failure) */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     /* The one we're looking for is probably just before comppad_name_fill. */
     for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
@@ -523,7 +508,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     }
     SvFLAGS(sv) |= tmptype;
     PL_curpad = AvARRAY(PL_comppad);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
 			  PTR2UV(thr), PTR2UV(PL_curpad),
@@ -533,14 +518,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 			  "Pad 0x%"UVxf" alloc %ld for %s\n",
 			  PTR2UV(PL_curpad),
 			  (long) retval, PL_op_name[optype]));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     return (PADOFFSET)retval;
 }
 
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
 			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
@@ -549,7 +534,7 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
 			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     return PL_curpad[po];		/* eventually we'll turn this into a macro */
 }
 
@@ -562,14 +547,14 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_free curpad");
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_free po");
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "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 %"IVdf"\n",
 			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
 	SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
@@ -587,14 +572,14 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_swipe curpad");
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_swipe po");
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "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 %"IVdf"\n",
 			  PTR2UV(PL_curpad), (IV)po));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
     SvPADTMP_on(PL_curpad[po]);
@@ -616,14 +601,14 @@ Perl_pad_reset(pTHX)
 
     if (AvARRAY(PL_comppad) != PL_curpad)
 	Perl_croak(aTHX_ "panic: pad_reset curpad");
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf" Pad 0x%"UVxf" reset\n",
 			  PTR2UV(thr), PTR2UV(PL_curpad)));
 #else
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
 			  PTR2UV(PL_curpad)));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     if (!PL_tainting) {	/* Can't mix tainted and non-tainted temporaries. */
 	for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
 	    if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
@@ -635,7 +620,7 @@ Perl_pad_reset(pTHX)
     PL_pad_reset_pending = FALSE;
 }
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 /* find_threadsv is not reentrant */
 PADOFFSET
 Perl_find_threadsv(pTHX_ const char *name)
@@ -667,7 +652,7 @@ Perl_find_threadsv(pTHX_ const char *name)
 	    break;
 	case ';':
 	    sv_setpv(sv, "\034");
-	    sv_magic(sv, 0, 0, name, 1);
+	    sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
 	    break;
 	case '&':
 	case '`':
@@ -691,7 +676,7 @@ Perl_find_threadsv(pTHX_ const char *name)
 	/* case '!': */
 
 	default:
-	    sv_magic(sv, 0, 0, name, 1);
+	    sv_magic(sv, 0, PERL_MAGIC_sv, name, 1);
 	}
 	DEBUG_S(PerlIO_printf(Perl_error_log,
 			      "find_threadsv: new SV %p for $%s%c\n",
@@ -700,7 +685,7 @@ Perl_find_threadsv(pTHX_ const char *name)
     }
     return key;
 }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
 /* Destructor */
 
@@ -759,23 +744,24 @@ Perl_op_free(pTHX_ OP *o)
 #endif
 }
 
-STATIC void
-S_op_clear(pTHX_ OP *o)
+void
+Perl_op_clear(pTHX_ OP *o)
 {
+
     switch (o->op_type) {
     case OP_NULL:	/* Was holding old type, if any. */
     case OP_ENTEREVAL:	/* Was holding hints. */
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     case OP_THREADSV:	/* Was holding index into thr->threadsv AV. */
 #endif
 	o->op_targ = 0;
 	break;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     case OP_ENTERITER:
 	if (!(o->op_flags & OPf_SPECIAL))
 	    break;
 	/* FALL THROUGH */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     default:
 	if (!(o->op_flags & OPf_REF)
 	    || (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)))
@@ -859,16 +845,30 @@ clear_pmop:
 		    lastpmop = pmop;
 		    pmop = pmop->op_pmnext;
 		}
+	    }
 #ifdef USE_ITHREADS
-		Safefree(PmopSTASHPV(cPMOPo));
+	    Safefree(PmopSTASHPV(cPMOPo));
 #else
-		/* NOTE: PMOP.op_pmstash is not refcounted */
+	    /* NOTE: PMOP.op_pmstash is not refcounted */
 #endif
-	    }
 	}
 	cPMOPo->op_pmreplroot = Nullop;
-	ReREFCNT_dec(cPMOPo->op_pmregexp);
-	cPMOPo->op_pmregexp = (REGEXP*)NULL;
+        /* we use the "SAFE" version of the PM_ macros here
+         * since sv_clean_all might release some PMOPs
+         * after PL_regex_padav has been cleared
+         * and the clearing of PL_regex_padav needs to
+         * happen before sv_clean_all
+         */
+	ReREFCNT_dec(PM_GETRE_SAFE(cPMOPo));
+	PM_SETRE_SAFE(cPMOPo, (REGEXP*)NULL);
+#ifdef USE_ITHREADS
+	if(PL_regex_pad) {        /* We could be in destruction */
+            av_push((AV*) PL_regex_pad[0],(SV*) PL_regex_pad[(cPMOPo)->op_pmoffset]);
+	    SvREPADTMP_on(PL_regex_pad[(cPMOPo)->op_pmoffset]);
+            PM_SETRE(cPMOPo, (cPMOPo)->op_pmoffset);
+        }
+#endif 
+
 	break;
     }
 
@@ -895,8 +895,8 @@ S_cop_free(pTHX_ COP* cop)
 	SvREFCNT_dec(cop->cop_io);
 }
 
-STATIC void
-S_null(pTHX_ OP *o)
+void
+Perl_op_null(pTHX_ OP *o)
 {
     if (o->op_type == OP_NULL)
 	return;
@@ -977,8 +977,6 @@ Perl_scalar(pTHX_ OP *o)
 
     switch (o->op_type) {
     case OP_REPEAT:
-	if (o->op_private & OPpREPEAT_DOLIST)
-	    null(((LISTOP*)cBINOPo->op_first)->op_first);
 	scalar(cBINOPo->op_first);
 	break;
     case OP_OR:
@@ -1144,7 +1142,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_GETLOGIN:
       func_ops:
 	if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
-	    useless = PL_op_desc[o->op_type];
+	    useless = OP_DESC(o);
 	break;
 
     case OP_RV2GV:
@@ -1163,6 +1161,9 @@ Perl_scalarvoid(pTHX_ OP *o)
 	else {
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
+		/* the constants 0 and 1 are permitted as they are
+		   conventionally used as dummies in constructs like
+		        1 while some_condition_with_side_effects;  */
 		if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 		    useless = 0;
 		else if (SvPOK(sv)) {
@@ -1179,7 +1180,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 		}
 	    }
 	}
-	null(o);		/* don't execute or even remember it */
+	op_null(o);		/* don't execute or even remember it */
 	break;
 
     case OP_POSTINC:
@@ -1384,31 +1385,6 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	PL_modcount++;
 	return o;
     case OP_CONST:
-        if (o->op_private & (OPpCONST_BARE) &&
-                !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
-            SV *sv = ((SVOP*)o)->op_sv;
-            GV *gv;
-
-            /* Could be a filehandle */
-            if ((gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO))) {
-                OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
-                op_free(o);
-                o = gvio;
-            } else {
-                /* OK, it's a sub */
-                OP* enter;
-                gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
-
-                enter = newUNOP(OP_ENTERSUB,0,
-                        newUNOP(OP_RV2CV, 0,
-                            newGVOP(OP_GV, 0, gv)
-                        ));
-                enter->op_private |= OPpLVAL_INTRO;
-                op_free(o);
-                o = enter;
-            }
-            break;
-        }
 	if (!(o->op_private & (OPpCONST_ARYBASE)))
 	    goto nomod;
 	if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
@@ -1434,7 +1410,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    o->op_type = OP_RV2CV;		/* entersub => rv2cv */
 	    o->op_ppaddr = PL_ppaddr[OP_RV2CV];
 	    assert(cUNOPo->op_first->op_type == OP_NULL);
-	    null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
+	    op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
 	    break;
 	}
 	else {				/* lvalue subroutine call */
@@ -1535,7 +1511,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		      ? "do block"
 		      : (o->op_type == OP_ENTERSUB
 			? "non-lvalue subroutine call"
-			: PL_op_desc[o->op_type])),
+			: OP_DESC(o))),
 		     type ? PL_op_desc[type] : "local"));
 	return o;
 
@@ -1626,11 +1602,11 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
 	break;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     case OP_THREADSV:
 	PL_modcount++;	/* XXX ??? */
 	break;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     case OP_PUSHMARK:
 	break;
@@ -1806,7 +1782,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
 	    o->op_type = OP_RV2CV;             /* entersub => rv2cv */
 	    o->op_ppaddr = PL_ppaddr[OP_RV2CV];
 	    assert(cUNOPo->op_first->op_type == OP_NULL);
-	    null(((LISTOP*)cUNOPo->op_first)->op_first);	/* disable pushmark */
+	    op_null(((LISTOP*)cUNOPo->op_first)->op_first);	/* disable pushmark */
 	    o->op_flags |= OPf_SPECIAL;
 	}
 	break;
@@ -1911,7 +1887,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     ENTER;		/* need to protect against side-effects of 'use' */
     SAVEINT(PL_expect);
-    if (stash && HvNAME(stash))
+    if (stash)
 	stashsv = newSVpv(HvNAME(stash), 0);
     else
 	stashsv = &PL_sv_no;
@@ -1997,7 +1973,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 	     type != OP_PUSHMARK)
     {
 	yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
-			  PL_op_desc[o->op_type],
+			  OP_DESC(o),
 			  PL_in_my == KEY_our ? "our" : "my"));
 	return o;
     }
@@ -2011,7 +1987,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 
 	/* 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)))
+	if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED))
 	    stash = SvSTASH(*namesvp);
 	else
 	    stash = PL_curstash;
@@ -2076,9 +2052,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 	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 ((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)))
 	    left = mod(left, right->op_type);
 	if (right->op_type == OP_TRANS)
 	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2118,7 +2100,7 @@ Perl_scope(pTHX_ OP *o)
 		o->op_ppaddr = PL_ppaddr[OP_SCOPE];
 		kid = ((LISTOP*)o)->op_first;
 		if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-		    null(kid);
+		    op_null(kid);
 	    }
 	    else
 		o = newLISTOP(OP_SCOPE, 0, o, Nullop);
@@ -2173,7 +2155,10 @@ OP*
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
-    OP* retval = scalarseq(seq);
+    line_t copline = PL_copline;
+    /* there should be a nextstate in every block */
+    OP* retval = seq ? scalarseq(seq) : newSTATEOP(0, Nullch, seq);
+    PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
     LEAVE_SCOPE(floor);
     PL_pad_reset_pending = FALSE;
     PL_compiling.op_private = PL_hints;
@@ -2187,13 +2172,13 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
 STATIC OP *
 S_newDEFSVOP(pTHX)
 {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     OP *o = newOP(OP_THREADSV, 0);
     o->op_targ = find_threadsv("_");
     return o;
 #else
     return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 }
 
 void
@@ -2209,7 +2194,7 @@ Perl_newPROG(pTHX_ OP *o)
 	PL_eval_root->op_private |= OPpREFCOUNTED;
 	OpREFCNT_set(PL_eval_root, 1);
 	PL_eval_root->op_next = 0;
-	peep(PL_eval_start);
+	CALL_PEEP(PL_eval_start);
     }
     else {
 	if (!o)
@@ -2220,7 +2205,7 @@ Perl_newPROG(pTHX_ OP *o)
 	PL_main_root->op_private |= OPpREFCOUNTED;
 	OpREFCNT_set(PL_main_root, 1);
 	PL_main_root->op_next = 0;
-	peep(PL_main_start);
+	CALL_PEEP(PL_main_start);
 	PL_compcv = 0;
 
 	/* Register with debugger */
@@ -2243,9 +2228,14 @@ Perl_localize(pTHX_ OP *o, I32 lex)
     if (o->op_flags & OPf_PARENS)
 	list(o);
     else {
-	if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
-	    char *s;
-	    for (s = PL_bufptr; *s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ",*s)); s++) ;
+	if (ckWARN(WARN_PARENTHESIS)
+	    && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
+	{
+	    char *s = PL_bufptr;
+
+	    while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s)))
+		s++;
+
 	    if (*s == ';' || *s == '=')
 		Perl_warner(aTHX_ WARN_PARENTHESIS,
 			    "Parentheses missing around \"%s\" list",
@@ -2266,12 +2256,12 @@ Perl_jmaybe(pTHX_ OP *o)
 {
     if (o->op_type == OP_LIST) {
 	OP *o2;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	o2 = newOP(OP_THREADSV, 0);
 	o2->op_targ = find_threadsv(";");
 #else
 	o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 	o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
     }
     return o;
@@ -2316,8 +2306,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     case OP_SLE:
     case OP_SGE:
     case OP_SCMP:
-
-	if (o->op_private & OPpLOCALE)
+	/* XXX what about the numeric ops? */
+	if (PL_hints & HINT_LOCALE)
 	    goto nope;
     }
 
@@ -2404,7 +2394,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
-    peep(curop);
+    CALL_PEEP(curop);
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
@@ -2429,7 +2419,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
 	o->op_flags &= ~OPf_WANT;
 
     if (!(PL_opargs[type] & OA_MARK))
-	null(cLISTOPo->op_first);
+	op_null(cLISTOPo->op_first);
 
     o->op_type = type;
     o->op_ppaddr = PL_ppaddr[type];
@@ -2539,7 +2529,7 @@ Perl_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
 	o = newLISTOP(OP_LIST, 0, o, Nullop);
-    null(o);
+    op_null(o);
     return o;
 }
 
@@ -2680,6 +2670,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     I32 grows = 0;
     register short *tbl;
 
+    PL_hints |= HINT_BLOCK_SCOPE;
     complement	= o->op_private & OPpTRANS_COMPLEMENT;
     del		= o->op_private & OPpTRANS_DELETE;
     squash	= o->op_private & OPpTRANS_SQUASH;
@@ -2707,11 +2698,22 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	U32 max = 0;
 	I32 bits;
 	I32 havefinal = 0;
-	U32 final;
+	U32 final = 0;
 	I32 from_utf	= o->op_private & OPpTRANS_FROM_UTF;
 	I32 to_utf	= o->op_private & OPpTRANS_TO_UTF;
-	U8* tsave = from_utf ? NULL : trlist_upgrade(&t, &tend);
-	U8* rsave = (to_utf || !rlen) ? NULL : trlist_upgrade(&r, &rend);
+	U8* tsave = NULL;
+	U8* rsave = NULL;
+
+	if (!from_utf) {
+	    STRLEN len = tlen;
+	    tsave = t = bytes_to_utf8(t, &len);
+	    tend = t + len;
+	}
+	if (!to_utf && rlen) {
+	    STRLEN len = rlen;
+	    rsave = r = bytes_to_utf8(r, &len);
+	    rend = r + len;
+	}
 
 /* There are several snags with this code on EBCDIC:
    1. 0xFF is a legal UTF-EBCDIC byte (there are no illegal bytes).
@@ -2971,7 +2973,24 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 	pmop->op_pmpermflags |= PMf_LOCALE;
     pmop->op_pmflags = pmop->op_pmpermflags;
 
-    /* link into pm list */
+#ifdef USE_ITHREADS
+    {
+        SV* repointer;
+        if(av_len((AV*) PL_regex_pad[0]) > -1) {
+	    repointer = av_pop((AV*)PL_regex_pad[0]);
+            pmop->op_pmoffset = SvIV(repointer);
+	    SvREPADTMP_off(repointer);
+	    sv_setiv(repointer,0);
+        } else { 
+            repointer = newSViv(0);
+            av_push(PL_regex_padav,SvREFCNT_inc(repointer));
+            pmop->op_pmoffset = av_len(PL_regex_padav);
+            PL_regex_pad = AvARRAY(PL_regex_padav);
+        }
+    }
+#endif
+        
+        /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
 	HvPMROOT(PL_curstash) = pmop;
@@ -3003,16 +3022,12 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	    p = SvPV(pat, plen);
 	    pm->op_pmflags |= PMf_SKIPWHITE;
 	}
-	if ((PL_hints & HINT_UTF8) || DO_UTF8(pat))
-	    pm->op_pmdynflags |= PMdf_UTF8;
-	pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
-	if (strEQ("\\s+", pm->op_pmregexp->precomp))
+	PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+	if (strEQ("\\s+", PM_GETRE(pm)->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
@@ -3049,21 +3064,21 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	    if (CopLINE(PL_curcop) < PL_multi_end)
 		CopLINE_set(PL_curcop, PL_multi_end);
 	}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	else if (repl->op_type == OP_THREADSV
 		 && strchr("&`'123456789+",
 			   PL_threadsv_names[repl->op_targ]))
 	{
 	    curop = 0;
 	}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 	else if (repl->op_type == OP_CONST)
 	    curop = repl;
 	else {
 	    OP *lastop = 0;
 	    for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
 		if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 		    if (curop->op_type == OP_THREADSV) {
 			repl_has_vars = 1;
 			if (strchr("&`'123456789+", curop->op_private))
@@ -3076,7 +3091,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 			if (strchr("&`'123456789+", *GvENAME(gv)))
 			    break;
 		    }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 		    else if (curop->op_type == OP_RV2CV)
 			break;
 		    else if (curop->op_type == OP_RV2SV ||
@@ -3102,14 +3117,14 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	}
 	if (curop == repl
 	    && !(repl_has_vars
-		 && (!pm->op_pmregexp
-		     || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
+		 && (!PM_GETRE(pm)
+		     || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
 	    pm->op_pmflags |= PMf_CONST;	/* const for long enough */
 	    pm->op_pmpermflags |= PMf_CONST;	/* const for long enough */
 	    prepend_elem(o->op_type, scalar(repl), o);
 	}
 	else {
-	    if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+	    if (curop == repl && !PM_GETRE(pm)) { /* Has variables. */
 		pm->op_pmflags |= PMf_MAYBE_CONST;
 		pm->op_pmpermflags |= PMf_MAYBE_CONST;
 	    }
@@ -3216,6 +3231,7 @@ Perl_package(pTHX_ OP *o)
 	op_free(o);
     }
     else {
+	deprecate("\"package\" with no arguments");
 	sv_setpv(PL_curstname,"<none>");
 	PL_curstash = Nullhv;
     }
@@ -3228,10 +3244,11 @@ void
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
-    OP *rqop;
     OP *imop;
     OP *veop;
-    GV *gv;
+    char *packname = Nullch;
+    STRLEN packlen = 0;
+    SV *packsv;
 
     if (id->op_type != OP_CONST)
 	Perl_croak(aTHX_ "Module name must be constant");
@@ -3289,20 +3306,13 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 				   newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
-    /* Fake up a require, handle override, if any */
-    gv = gv_fetchpv("require", FALSE, SVt_PVCV);
-    if (!(gv && GvIMPORTED_CV(gv)))
-	gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
-
-    if (gv && GvIMPORTED_CV(gv)) {
-	rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
-			       append_elem(OP_LIST, id,
-					   scalar(newUNOP(OP_RV2CV, 0,
-							  newGVOP(OP_GV, 0,
-								  gv))))));
-    }
-    else {
-	rqop = newUNOP(OP_REQUIRE, 0, id);
+    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. */
@@ -3312,15 +3322,38 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	Nullop,
 	append_elem(OP_LINESEQ,
 	    append_elem(OP_LINESEQ,
-	        newSTATEOP(0, Nullch, rqop),
+	        newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)),
 	        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);
+    }
+
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
 }
 
+/*
+=for apidoc load_module
+
+Loads the module whose name is pointed to by the string part of name.
+Note that the actual module name, not its filename, should be given.
+Eg, "Foo::Bar" instead of "Foo/Bar.pm".  flags can be any of
+PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
+(or 0 for no flags). ver, if specified, provides version semantics
+similar to C<use Foo::Bar VERSION>.  The optional trailing SV*
+arguments can be used to specify arguments to the module's import()
+method, similar to C<use Foo::Bar VERSION LIST>.
+
+=cut */
+
 void
 Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
 {
@@ -3616,7 +3649,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_BYTE);
+    cop->op_private = (PL_hints & HINT_PRIVATE_MASK);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -3964,7 +3997,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     OP *next = 0;
     OP *listop;
     OP *o;
-    OP *condop;
     U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
@@ -4026,7 +4058,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 	    return Nullop;		/* listop already freed by new_logop */
 	}
 	if (listop)
-	    ((LISTOP*)listop)->op_last->op_next = condop =
+	    ((LISTOP*)listop)->op_last->op_next =
 		(o == listop ? redo : LINKLIST(o));
     }
     else
@@ -4086,7 +4118,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 	    Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
     }
     else {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	padoff = find_threadsv("_");
 	iterflags |= OPf_SPECIAL;
 #else
@@ -4122,7 +4154,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 
 	op_free(expr);
 	expr = (OP*)(listop);
-        null(expr);
+        op_null(expr);
 	iterflags |= OPf_STACKED;
     }
     else {
@@ -4178,22 +4210,30 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     if (CvMUTEXP(cv)) {
 	MUTEX_DESTROY(CvMUTEXP(cv));
 	Safefree(CvMUTEXP(cv));
 	CvMUTEXP(cv) = 0;
     }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
+
+#ifdef USE_ITHREADS
+    if (CvFILE(cv) && !CvXSUB(cv)) {
+	/* for XSUBs CvFILE point directly to static memory; __FILE__ */
+	Safefree(CvFILE(cv));
+    }
+    CvFILE(cv) = 0;
+#endif
 
     if (!CvXSUB(cv) && CvROOT(cv)) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
 	    Perl_croak(aTHX_ "Can't undef active subroutine");
 #else
 	if (CvDEPTH(cv))
 	    Perl_croak(aTHX_ "Can't undef active subroutine");
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 	ENTER;
 
 	SAVEVPTR(PL_curpad);
@@ -4209,9 +4249,15 @@ 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.  --GSAR */
-    if (!CvANON(cv) || CvCLONED(cv))
+     * 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))))
+    {
 	SvREFCNT_dec(CvOUTSIDE(cv));
+    }
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4238,6 +4284,9 @@ Perl_cv_undef(pTHX_ CV *cv)
 	}
 	CvPADLIST(cv) = Nullav;
     }
+    if (CvXSUB(cv)) {
+        CvXSUB(cv) = 0;
+    }
     CvFLAGS(cv) = 0;
 }
 
@@ -4317,12 +4366,17 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
     CvCLONED_on(cv);
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)		= 0;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
+#ifdef USE_ITHREADS
+    CvFILE(cv)		= CvXSUB(proto) ? CvFILE(proto)
+					: savepv(CvFILE(proto));
+#else
     CvFILE(cv)		= CvFILE(proto);
+#endif
     CvGV(cv)		= CvGV(proto);
     CvSTASH(cv)		= CvSTASH(proto);
     CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
@@ -4464,7 +4518,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
     }
 }
 
-static void const_sv_xsub(pTHXo_ CV* cv);
+static void const_sv_xsub(pTHX_ CV* cv);
 
 /*
 =for apidoc cv_const_sv
@@ -4611,9 +4665,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     cv = (!name || GvCVGEN(gv)) ? Nullcv : GvCV(gv);
 
-#ifdef GV_SHARED_CHECK
-    if (cv && GvSHARED(gv) && SvREADONLY(cv)) {
-        Perl_croak(aTHX_ "Can't define subroutine %s (GV is shared)", name);
+#ifdef GV_UNIQUE_CHECK
+    if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
+        Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
     }
 #endif
 
@@ -4625,9 +4679,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (cv) {
         bool exists = CvROOT(cv) || CvXSUB(cv);
 
-#ifdef GV_SHARED_CHECK
-        if (exists && GvSHARED(gv)) {
-            Perl_croak(aTHX_ "Can't redefine shared subroutine %s", name);
+#ifdef GV_UNIQUE_CHECK
+        if (exists && GvUNIQUE(gv)) {
+            Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
         }
 #endif
 
@@ -4653,7 +4707,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 			&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
 		{
 		    line_t oldline = CopLINE(PL_curcop);
-		    CopLINE_set(PL_curcop, PL_copline);
+		    if (PL_copline != NOLINE)
+			CopLINE_set(PL_curcop, PL_copline);
 		    Perl_warner(aTHX_ WARN_REDEFINE,
 			CvCONST(cv) ? "Constant subroutine %s redefined"
 				    : "Subroutine %s redefined", name);
@@ -4692,9 +4747,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	 */
 	if (cv && !block) {
 	    rcv = (SV*)cv;
-	    if (CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))))
+	    if (CvGV(cv) && GvSTASH(CvGV(cv)))
 		stash = GvSTASH(CvGV(cv));
-	    else if (CvSTASH(cv) && HvNAME(CvSTASH(cv)))
+	    else if (CvSTASH(cv))
 		stash = CvSTASH(cv);
 	    else
 		stash = PL_curstash;
@@ -4702,7 +4757,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	else {
 	    /* possibly about to re-define existing subr -- ignore old cv */
 	    rcv = (SV*)PL_compcv;
-	    if (name && GvSTASH(gv) && HvNAME(GvSTASH(gv)))
+	    if (name && GvSTASH(gv))
 		stash = GvSTASH(gv);
 	    else
 		stash = PL_curstash;
@@ -4746,6 +4801,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
 	/* ... before we throw it away */
 	SvREFCNT_dec(PL_compcv);
+	if (PERLDB_INTER)/* Advice debugger on the new sub. */
+	  ++PL_sub_generation;
     }
     else {
 	cv = PL_compcv;
@@ -4756,15 +4813,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
     }
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH(cv) = PL_curstash;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     CvOWNER(cv) = 0;
     if (!CvMUTEXP(cv)) {
 	New(666, CvMUTEXP(cv), 1, perl_mutex);
 	MUTEX_INIT(CvMUTEXP(cv));
     }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     if (ps)
 	sv_setpv((SV*)cv, ps);
@@ -4805,7 +4862,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
+    CALL_PEEP(CvSTART(cv));
 
     /* now that optimizer has done its work, adjust pad values */
     if (CvCLONE(cv)) {
@@ -4847,12 +4904,17 @@ 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.
+    /* If a potential closure prototype, don't keep a refcount on
+     * outer CV, unless the latter happens to be a passing eval"".
      * 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)
+    if (!name && CvOUTSIDE(cv)
+	&& !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+	     && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+    {
 	SvREFCNT_dec(CvOUTSIDE(cv));
+    }
 
     if (name || aname) {
 	char *s;
@@ -5011,7 +5073,6 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
 	    /* already defined (or promised) */
 	    if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-			    && HvNAME(GvSTASH(CvGV(cv)))
 			    && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
 		line_t oldline = CopLINE(PL_curcop);
 		if (PL_copline != NOLINE)
@@ -5039,11 +5100,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	}
     }
     CvGV(cv) = gv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv) = 0;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     (void)gv_fetchfile(filename);
     CvFILE(cv) = filename;	/* NOTE: not copied, as it is expected to be
 				   an external constant string */
@@ -5111,17 +5172,17 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     else
 	name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
-#ifdef GV_SHARED_CHECK
-    if (GvSHARED(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is shared)");
+#ifdef GV_UNIQUE_CHECK
+    if (GvUNIQUE(gv)) {
+        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
     }
 #endif
     GvMULTI_on(gv);
     if ((cv = GvFORM(gv))) {
 	if (ckWARN(WARN_REDEFINE)) {
 	    line_t oldline = CopLINE(PL_curcop);
-
-	    CopLINE_set(PL_curcop, PL_copline);
+	    if (PL_copline != NOLINE)
+		CopLINE_set(PL_curcop, PL_copline);
 	    Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
 	    CopLINE_set(PL_curcop, oldline);
 	}
@@ -5130,7 +5191,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -5142,7 +5203,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
+    CALL_PEEP(CvSTART(cv));
     op_free(o);
     PL_copline = NOLINE;
     LEAVE_SCOPE(floor);
@@ -5232,6 +5293,11 @@ Perl_newAVREF(pTHX_ OP *o)
 	o->op_ppaddr = PL_ppaddr[OP_PADAV];
 	return o;
     }
+    else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
+		&& ckWARN(WARN_DEPRECATED)) {
+	Perl_warner(aTHX_ WARN_DEPRECATED,
+		"Using an array as a reference is deprecated");
+    }
     return newUNOP(OP_RV2AV, 0, scalar(o));
 }
 
@@ -5251,6 +5317,11 @@ Perl_newHVREF(pTHX_ OP *o)
 	o->op_ppaddr = PL_ppaddr[OP_PADHV];
 	return o;
     }
+    else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
+		&& ckWARN(WARN_DEPRECATED)) {
+	Perl_warner(aTHX_ WARN_DEPRECATED,
+		"Using a hash as a reference is deprecated");
+    }
     return newUNOP(OP_RV2HV, 0, scalar(o));
 }
 
@@ -5366,9 +5437,9 @@ Perl_ck_delete(pTHX_ OP *o)
 	    break;
 	default:
 	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
-		  PL_op_desc[o->op_type]);
+		  OP_DESC(o));
 	}
-	null(kid);
+	op_null(kid);
     }
     return o;
 }
@@ -5398,7 +5469,7 @@ Perl_ck_eval(pTHX_ OP *o)
 
 	if (!kid) {
 	    o->op_flags &= ~OPf_KIDS;
-	    null(o);
+	    op_null(o);
 	}
 	else if (kid->op_type == OP_LINESEQ) {
 	    LOGOP *enter;
@@ -5454,7 +5525,7 @@ Perl_ck_exec(pTHX_ OP *o)
 	o = ck_fun(o);
 	kid = cUNOPo->op_first->op_sibling;
 	if (kid->op_type == OP_RV2GV)
-	    null(kid);
+	    op_null(kid);
     }
     else
 	o = listkids(o);
@@ -5471,15 +5542,15 @@ Perl_ck_exists(pTHX_ OP *o)
 	    (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]);
+			    OP_DESC(o));
 	    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);
+		        OP_DESC(o));
+	op_null(kid);
     }
     return o;
 }
@@ -5632,13 +5703,6 @@ Perl_ck_ftst(pTHX_ OP *o)
 	else
 	    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;
 }
 
@@ -5694,6 +5758,12 @@ Perl_ck_fun(pTHX_ OP *o)
 		    list(kid);
 		break;
 	    case OA_AVREF:
+		if ((type == OP_PUSH || type == OP_UNSHIFT)
+		    && !kid->op_sibling && ckWARN(WARN_SYNTAX))
+		    Perl_warner(aTHX_ WARN_SYNTAX,
+			"Useless use of %s with no values",
+			PL_op_desc[type]);
+		    
 		if (kid->op_type == OP_CONST &&
 		    (kid->op_private & OPpCONST_BARE))
 		{
@@ -5757,7 +5827,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		    }
 		    else if (kid->op_type == OP_READLINE) {
 			/* neophyte patrol: open(<FH>), close(<FH>) etc. */
-			bad_type(numargs, "HANDLE", PL_op_desc[o->op_type], kid);
+			bad_type(numargs, "HANDLE", OP_DESC(o), kid);
 		    }
 		    else {
 			I32 flags = OPf_SPECIAL;
@@ -5825,7 +5895,7 @@ Perl_ck_fun(pTHX_ OP *o)
 	}
 	o->op_private |= numargs;
 	if (kid)
-	    return too_many_arguments(o,PL_op_desc[o->op_type]);
+	    return too_many_arguments(o,OP_DESC(o));
 	listkids(o);
     }
     else if (PL_opargs[type] & OA_DEFGV) {
@@ -5837,7 +5907,7 @@ Perl_ck_fun(pTHX_ OP *o)
 	while (oa & OA_OPTIONAL)
 	    oa >>= 4;
 	if (oa && oa != OA_LIST)
-	    return too_few_arguments(o,PL_op_desc[o->op_type]);
+	    return too_few_arguments(o,OP_DESC(o));
     }
     return o;
 }
@@ -5857,11 +5927,15 @@ Perl_ck_glob(pTHX_ OP *o)
 #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_ 0, newSVpvn("File::Glob", 10), Nullsv,
-			 /* null-terminated import list */
-			 newSVpvn(":globally", 9), 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);
+	SvREFCNT_inc((SV*)GvCV(gv));
+	GvIMPORTED_CV_on(gv);
 	LEAVE;
     }
 #endif /* PERL_EXTERNAL_GLOB */
@@ -5932,7 +6006,7 @@ Perl_ck_grep(pTHX_ OP *o)
 
     kid = cLISTOPo->op_first->op_sibling;
     if (!kid || !kid->op_sibling)
-	return too_few_arguments(o,PL_op_desc[o->op_type]);
+	return too_few_arguments(o,OP_DESC(o));
     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
 	mod(kid, OP_GREPSTART);
 
@@ -6038,29 +6112,7 @@ Perl_ck_listiob(pTHX_ OP *o)
     if (!kid)
 	append_elem(o->op_type, o, newDEFSVOP());
 
-    o = listkids(o);
-
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-	o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
-}
-
-OP *
-Perl_ck_fun_locale(pTHX_ OP *o)
-{
-    o = ck_fun(o);
-
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-	o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
+    return listkids(o);
 }
 
 OP *
@@ -6094,18 +6146,6 @@ Perl_ck_sassign(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_scmp(pTHX_ OP *o)
-{
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-	o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
-}
-
-OP *
 Perl_ck_match(pTHX_ OP *o)
 {
     o->op_private |= OPpRUNTIME;
@@ -6185,6 +6225,8 @@ Perl_ck_repeat(pTHX_ OP *o)
 OP *
 Perl_ck_require(pTHX_ OP *o)
 {
+    GV* gv;
+
     if (o->op_flags & OPf_KIDS) {	/* Shall we supply missing .pm? */
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
 
@@ -6206,6 +6248,23 @@ Perl_ck_require(pTHX_ OP *o)
 		sv_catpvn(kid->op_sv, ".pm", 3);
 	}
     }
+
+    /* handle override, if any */
+    gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+    if (!(gv && GvIMPORTED_CV(gv)))
+	gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+    if (gv && GvIMPORTED_CV(gv)) {
+	OP *kid = cUNOPo->op_first;
+	cUNOPo->op_first = 0;
+	op_free(o);
+	return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+			       append_elem(OP_LIST, kid,
+					   scalar(newUNOP(OP_RV2CV, 0,
+							  newGVOP(OP_GV, 0,
+								  gv))))));
+    }
+
     return ck_fun(o);
 }
 
@@ -6259,7 +6318,7 @@ Perl_ck_shift(pTHX_ OP *o)
 	OP *argop;
 	
 	op_free(o);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	if (!CvUNIQUE(PL_compcv)) {
 	    argop = newOP(OP_PADAV, OPf_REF);
 	    argop->op_targ = 0;		/* PL_curpad[0] is @_ */
@@ -6273,7 +6332,7 @@ Perl_ck_shift(pTHX_ OP *o)
 	argop = newUNOP(OP_RV2AV, 0,
 	    scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
 			   PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 	return newUNOP(type, 0, scalar(argop));
     }
     return scalar(modkids(ck_fun(o), type));
@@ -6283,17 +6342,12 @@ OP *
 Perl_ck_sort(pTHX_ OP *o)
 {
     OP *firstkid;
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-	o->op_private |= OPpLOCALE;
-#endif
 
     if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
 	simplify_sort(o);
     firstkid = cLISTOPo->op_first->op_sibling;		/* get past pushmark */
     if (o->op_flags & OPf_STACKED) {			/* may have been cleared */
-	OP *k;
+	OP *k = NULL;
 	OP *kid = cUNOPx(firstkid)->op_first;		/* get past null */
 
 	if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
@@ -6304,7 +6358,7 @@ Perl_ck_sort(pTHX_ OP *o)
 	    }
 	    else if (kid->op_type == OP_LEAVE) {
 		if (o->op_type == OP_SORT) {
-		    null(kid);			/* wipe out leave */
+		    op_null(kid);			/* wipe out leave */
 		    kid->op_next = kid;
 
 		    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
@@ -6322,7 +6376,7 @@ Perl_ck_sort(pTHX_ OP *o)
 		    kid->op_next = 0;		/* just disconnect the leave */
 		k = kLISTOP->op_first;
 	    }
-	    peep(k);
+	    CALL_PEEP(k);
 
 	    kid = firstkid;
 	    if (o->op_type == OP_SORT) {
@@ -6335,7 +6389,7 @@ Perl_ck_sort(pTHX_ OP *o)
 	    o->op_flags |= OPf_SPECIAL;
 	}
 	else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
-	    null(firstkid);
+	    op_null(firstkid);
 
 	firstkid = firstkid->op_sibling;
     }
@@ -6457,7 +6511,7 @@ Perl_ck_split(pTHX_ OP *o)
     scalar(kid);
 
     if (kid->op_sibling)
-	return too_many_arguments(o,PL_op_desc[o->op_type]);
+	return too_many_arguments(o,OP_DESC(o));
 
     return o;
 }
@@ -6469,8 +6523,8 @@ Perl_ck_join(pTHX_ OP *o)
 	OP *kid = cLISTOPo->op_first->op_sibling;
 	if (kid && kid->op_type == OP_MATCH) {
 	    char *pmstr = "STRING";
-	    if (kPMOP->op_pmregexp)
-		pmstr = kPMOP->op_pmregexp->precomp;
+	    if (PM_GETRE(kPMOP))
+		pmstr = PM_GETRE(kPMOP)->precomp;
 	    Perl_warner(aTHX_ WARN_SYNTAX,
 			"/%s/ should probably be written as \"%s\"",
 			pmstr, pmstr);
@@ -6491,6 +6545,8 @@ Perl_ck_subr(pTHX_ OP *o)
     GV *namegv = 0;
     int optional = 0;
     I32 arg = 0;
+    I32 contextclass = 0;
+    char *e = 0;
     STRLEN n_a;
 
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -6498,7 +6554,7 @@ Perl_ck_subr(pTHX_ OP *o)
     if (cvop->op_type == OP_RV2CV) {
 	SVOP* tmpop;
 	o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
-	null(cvop);		/* disable rv2cv */
+	op_null(cvop);		/* disable rv2cv */
 	tmpop = (SVOP*)((UNOP*)cvop)->op_first;
 	if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
 	    GV *gv = cGVOPx_gv(tmpop);
@@ -6587,36 +6643,67 @@ Perl_ck_subr(pTHX_ OP *o)
 		}
 		scalar(o2);
 		break;
+	    case '[': case ']':
+		 goto oops;
+		 break;
 	    case '\\':
 		proto++;
 		arg++;
+	    again:
 		switch (*proto++) {
+		case '[':
+		     if (contextclass++ == 0) {
+		          e = strchr(proto, ']');
+			  if (!e || e == proto)
+			       goto oops;
+		     }
+		     else
+			  goto oops;
+		     goto again;
+		     break;
+		case ']':
+		     if (contextclass)
+			  contextclass = 0;
+		     else
+			  goto oops;
+		     break;
 		case '*':
-		    if (o2->op_type != OP_RV2GV)
-			bad_type(arg, "symbol", gv_ename(namegv), o2);
-		    goto wrapref;
+		     if (o2->op_type == OP_RV2GV)
+			  goto wrapref;
+		     if (!contextclass)
+			  bad_type(arg, "symbol", gv_ename(namegv), o2);
+		     break;
 		case '&':
-		    if (o2->op_type != OP_ENTERSUB)
-			bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
-		    goto wrapref;
+		     if (o2->op_type == OP_ENTERSUB)
+			  goto wrapref;
+		     if (!contextclass)
+			  bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
+		     break;
 		case '$':
-		    if (o2->op_type != OP_RV2SV
-			&& o2->op_type != OP_PADSV
-			&& o2->op_type != OP_HELEM
-			&& o2->op_type != OP_AELEM
-			&& o2->op_type != OP_THREADSV)
-		    {
+		    if (o2->op_type == OP_RV2SV ||
+			o2->op_type == OP_PADSV ||
+			o2->op_type == OP_HELEM ||
+			o2->op_type == OP_AELEM ||
+			o2->op_type == OP_THREADSV)
+			 goto wrapref;
+		    if (!contextclass)
 			bad_type(arg, "scalar", gv_ename(namegv), o2);
-		    }
-		    goto wrapref;
+		     break;
 		case '@':
-		    if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
+		    if (o2->op_type == OP_RV2AV ||
+			o2->op_type == OP_PADAV)
+			 goto wrapref;
+		    if (!contextclass)
 			bad_type(arg, "array", gv_ename(namegv), o2);
-		    goto wrapref;
+		    break;
 		case '%':
-		    if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
-			bad_type(arg, "hash", gv_ename(namegv), o2);
-		  wrapref:
+		    if (o2->op_type == OP_RV2HV ||
+			o2->op_type == OP_PADHV)
+			 goto wrapref;
+		    if (!contextclass)
+			 bad_type(arg, "hash", gv_ename(namegv), o2);
+		    break;
+		wrapref:
 		    {
 			OP* kid = o2;
 			OP* sib = kid->op_sibling;
@@ -6625,9 +6712,15 @@ Perl_ck_subr(pTHX_ OP *o)
 			o2->op_sibling = sib;
 			prev->op_sibling = o2;
 		    }
+		    if (contextclass && e) {
+			 proto = e + 1;
+			 contextclass = 0;
+		    }
 		    break;
 		default: goto oops;
 		}
+		if (contextclass)
+		     goto again;
 		break;
 	    case ' ':
 		proto++;
@@ -6635,7 +6728,7 @@ Perl_ck_subr(pTHX_ OP *o)
 	    default:
 	      oops:
 		Perl_croak(aTHX_ "Malformed prototype for %s: %s",
-			gv_ename(namegv), SvPV((SV*)cv, n_a));
+			   gv_ename(namegv), SvPV((SV*)cv, n_a));
 	    }
 	}
 	else
@@ -6760,7 +6853,7 @@ Perl_peep(pTHX_ register OP *o)
 			o->op_private |= OPpTARGET_MY;
 		    }
 		}
-		null(o->op_next);
+		op_null(o->op_next);
 	    }
 	  ignore_optimization:
 	    o->op_seq = PL_op_seqmax++;
@@ -6778,7 +6871,15 @@ Perl_peep(pTHX_ register OP *o)
 	    {
 		PL_curcop = ((COP*)o);
 	    }
-	    goto nothin;
+	    /* XXX: We avoid setting op_seq here to prevent later calls
+	       to peep() from mistakenly concluding that optimisation
+	       has already occurred. This doesn't fix the real problem,
+	       though (See 20010220.007). AMS 20010719 */
+	    if (oldop && o->op_next) {
+		oldop->op_next = o->op_next;
+		continue;
+	    }
+	    break;
 	case OP_SCALAR:
 	case OP_LINESEQ:
 	case OP_SCOPE:
@@ -6793,7 +6894,7 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_GV:
 	    if (o->op_next->op_type == OP_RV2SV) {
 		if (!(o->op_next->op_private & OPpDEREF)) {
-		    null(o->op_next);
+		    op_null(o->op_next);
 		    o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
 							       | OPpOUR_INTRO);
 		    o->op_next = o->op_next->op_next;
@@ -6809,14 +6910,14 @@ Perl_peep(pTHX_ register OP *o)
 		    pop->op_next->op_type == OP_AELEM &&
 		    !(pop->op_next->op_private &
 		      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
-		    (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
+		    (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase)
 				<= 255 &&
 		    i >= 0)
 		{
 		    GV *gv;
-		    null(o->op_next);
-		    null(pop->op_next);
-		    null(pop);
+		    op_null(o->op_next);
+		    op_null(pop->op_next);
+		    op_null(pop);
 		    o->op_flags |= pop->op_next->op_flags & OPf_MOD;
 		    o->op_next = pop->op_next->op_next;
 		    o->op_type = OP_AELEMFAST;
@@ -6837,6 +6938,15 @@ Perl_peep(pTHX_ register OP *o)
 				SvPV_nolen(sv));
 		}
 	    }
+	    else if (o->op_next->op_type == OP_READLINE
+		    && 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;
+		op_null(o->op_next->op_next);
+	    }
 
 	    o->op_seq = PL_op_seqmax++;
 	    break;
@@ -6852,10 +6962,11 @@ Perl_peep(pTHX_ register OP *o)
 	    o->op_seq = PL_op_seqmax++;
 	    while (cLOGOP->op_other->op_type == OP_NULL)
 		cLOGOP->op_other = cLOGOP->op_other->op_next;
-	    peep(cLOGOP->op_other);
+	    peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
 	    break;
 
 	case OP_ENTERLOOP:
+	case OP_ENTERITER:
 	    o->op_seq = PL_op_seqmax++;
 	    while (cLOOP->op_redoop->op_type == OP_NULL)
 		cLOOP->op_redoop = cLOOP->op_redoop->op_next;
@@ -6916,9 +7027,9 @@ Perl_peep(pTHX_ register OP *o)
 	    svp = cSVOPx_svp(((BINOP*)o)->op_last);
 	    if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
 		key = SvPV(sv, keylen);
-		if (SvUTF8(sv))
-		  keylen = -keylen;
-		lexname = newSVpvn_share(key, keylen, 0);
+		lexname = newSVpvn_share(key,
+					 SvUTF8(sv) ? -(I32)keylen : keylen,
+					 0);
 		SvREFCNT_dec(sv);
 		*svp = lexname;
 	    }
@@ -6930,15 +7041,14 @@ Perl_peep(pTHX_ register OP *o)
 	    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))
+	    if (!(SvFLAGS(lexname) & SVpad_TYPED))
 		break;
 	    fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
 	    if (!fields || !GvHV(*fields))
 		break;
 	    key = SvPV(*svp, keylen);
-	    if (SvUTF8(*svp))
-	        keylen = -keylen;
-	    indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+	    indsvp = hv_fetch(GvHV(*fields), key,
+			      SvUTF8(*svp) ? -(I32)keylen : 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)));
@@ -6980,7 +7090,7 @@ Perl_peep(pTHX_ register OP *o)
 	    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))
+	    if (!(SvFLAGS(lexname) & SVpad_TYPED))
 		break;
 	    fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
 	    if (!fields || !GvHV(*fields))
@@ -7003,9 +7113,8 @@ Perl_peep(pTHX_ register OP *o)
 		 key_op = (SVOP*)key_op->op_sibling) {
 		svp = cSVOPx_svp(key_op);
 		key = SvPV(*svp, keylen);
-		if (SvUTF8(*svp))
-	            keylen = -keylen;
-		indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+		indsvp = hv_fetch(GvHV(*fields), key,
+				  SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
 		if (!indsvp) {
 		    Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
 			       "in variable %s of type %s",
@@ -7034,11 +7143,49 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
+#ifdef PERL_CUSTOM_OPS
+char* custom_op_name(pTHX_ OP* o)
+{
+    IV  index = PTR2IV(o->op_ppaddr);
+    SV* keysv;
+    HE* he;
+
+    if (!PL_custom_op_names) /* This probably shouldn't happen */
+        return PL_op_name[OP_CUSTOM];
+
+    keysv = sv_2mortal(newSViv(index));
+
+    he = hv_fetch_ent(PL_custom_op_names, keysv, 0, 0);
+    if (!he)
+        return PL_op_name[OP_CUSTOM]; /* Don't know who you are */
+
+    return SvPV_nolen(HeVAL(he));
+}
+
+char* custom_op_desc(pTHX_ OP* o)
+{
+    IV  index = PTR2IV(o->op_ppaddr);
+    SV* keysv;
+    HE* he;
+
+    if (!PL_custom_op_descs)
+        return PL_op_desc[OP_CUSTOM];
+
+    keysv = sv_2mortal(newSViv(index));
+
+    he = hv_fetch_ent(PL_custom_op_descs, keysv, 0, 0);
+    if (!he)
+        return PL_op_desc[OP_CUSTOM];
+
+    return SvPV_nolen(HeVAL(he));
+}
+#endif
+
 #include "XSUB.h"
 
 /* Efficient sub that returns a constant scalar value. */
 static void
-const_sv_xsub(pTHXo_ CV* cv)
+const_sv_xsub(pTHX_ CV* cv)
 {
     dXSARGS;
     if (items != 0) {