X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7dafbf5232bace07a044625a5a956b73da3928d5..e3c9a8b9e0e8ab67833a50cc3f37939286b04437:/op.c

diff --git a/op.c b/op.c
index 46347da..46cc07b 100644
--- a/op.c
+++ b/op.c
@@ -1,6 +1,7 @@
 /*    op.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -29,13 +30,8 @@
 #define PERL_SLAB_SIZE 2048
 #endif
 
-#define NewOp(m,var,c,type) \
-	STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
-
-#define FreeOp(p) Slab_Free(p)
-
-STATIC void *
-S_Slab_Alloc(pTHX_ int m, size_t sz)
+void *
+Perl_Slab_Alloc(pTHX_ int m, size_t sz)
 {
     /*
      * To make incrementing use count easy PL_OpSlab is an I32 *
@@ -73,8 +69,8 @@ S_Slab_Alloc(pTHX_ int m, size_t sz)
     return (void *)(PL_OpPtr + 1);
 }
 
-STATIC void
-S_Slab_Free(pTHX_ void *op)
+void
+Perl_Slab_Free(pTHX_ void *op)
 {
     I32 **ptr = (I32 **) op;
     I32 *slab = ptr[-1];
@@ -82,9 +78,9 @@ S_Slab_Free(pTHX_ void *op)
     assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
     if (--(*slab) == 0) {
-     #ifdef NETWARE
-      #define PerlMemShared PerlMem
-     #endif
+#  ifdef NETWARE
+#    define PerlMemShared PerlMem
+#  endif
 	
     PerlMemShared_free(slab);
 	if (slab == PL_OpSlab) {
@@ -92,10 +88,6 @@ S_Slab_Free(pTHX_ void *op)
 	}
     }
 }
-
-#else
-#define NewOp(m, var, c, type) Newz(m, var, c, type)
-#define FreeOp(p) Safefree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -152,8 +144,8 @@ STATIC void
 S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
-		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
-		     SvPV_nolen(cSVOPo_sv)));
+		     "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
+		     cSVOPo_sv));
 }
 
 /* "register" allocation */
@@ -163,11 +155,11 @@ Perl_allocmy(pTHX_ char *name)
 {
     PADOFFSET off;
 
-    /* complain about "my $_" etc etc */
+    /* complain about "my $<special_var>" etc etc */
     if (!(PL_in_my == KEY_our ||
 	  isALPHA(name[1]) ||
 	  (USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
-	  (name[1] == '_' && (int)strlen(name) > 2)))
+	  (name[1] == '_' && (*name == '$' || (int)strlen(name) > 2))))
     {
 	if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
 	    /* 1999-02-27 mjd@plover.com */
@@ -193,7 +185,7 @@ Perl_allocmy(pTHX_ char *name)
 
     /* check for duplicate declaration */
     pad_check_dup(name,
-		PL_in_my == KEY_our,
+		(bool)(PL_in_my == KEY_our),
 		(PL_curstash ? PL_curstash : PL_defstash)
     );
 
@@ -224,7 +216,7 @@ Perl_op_free(pTHX_ OP *o)
     register OP *kid, *nextkid;
     OPCODE type;
 
-    if (!o || o->op_seq == (U16)-1)
+    if (!o || o->op_static)
 	return;
 
     if (o->op_private & OPpREFCOUNTED) {
@@ -283,22 +275,37 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
+	if (! (o->op_type == OP_AELEMFAST && o->op_flags & OPf_SPECIAL)) {
+	    /* not an OP_PADAV replacement */
 #ifdef USE_ITHREADS
-	if (cPADOPo->op_padix > 0) {
-	    /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
-	     * may still exist on the pad */
-	    pad_swipe(cPADOPo->op_padix, TRUE);
-	    cPADOPo->op_padix = 0;
-	}
+	    if (cPADOPo->op_padix > 0) {
+		/* No GvIN_PAD_off(cGVOPo_gv) here, because other references
+		 * may still exist on the pad */
+		pad_swipe(cPADOPo->op_padix, TRUE);
+		cPADOPo->op_padix = 0;
+	    }
 #else
-	SvREFCNT_dec(cSVOPo->op_sv);
-	cSVOPo->op_sv = Nullsv;
+	    SvREFCNT_dec(cSVOPo->op_sv);
+	    cSVOPo->op_sv = Nullsv;
 #endif
+	}
 	break;
     case OP_METHOD_NAMED:
     case OP_CONST:
 	SvREFCNT_dec(cSVOPo->op_sv);
 	cSVOPo->op_sv = Nullsv;
+#ifdef USE_ITHREADS
+	/** Bug #15654
+	  Even if op_clear does a pad_free for the target of the op,
+	  pad_free doesn't actually remove the sv that exists in the pad;
+	  instead it lives on. This results in that it could be reused as 
+	  a target later on when the pad was reallocated.
+	**/
+        if(o->op_targ) {
+          pad_swipe(o->op_targ,1);
+          o->op_targ = 0;
+        }
+#endif
 	break;
     case OP_GOTO:
     case OP_NEXT:
@@ -670,10 +677,14 @@ Perl_scalarvoid(pTHX_ OP *o)
 	else {
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
+		/* don't warn on optimised away booleans, eg 
+		 * use constant Foo, 5; Foo || print; */
+		if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
+		    useless = 0;
 		/* 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))
+		else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 		    useless = 0;
 		else if (SvPOK(sv)) {
                   /* perl4's way of mixing documentation and code
@@ -875,10 +886,23 @@ S_modkids(pTHX_ OP *o, I32 type)
     return o;
 }
 
+/* Propagate lvalue ("modifiable") context to an op and it's children.
+ * 'type' represents the context type, roughly based on the type of op that
+ * would do the modifying, although local() is represented by OP_NULL.
+ * It's responsible for detecting things that can't be modified,  flag
+ * things that need to behave specially in an lvalue context (e.g., "$$x = 5"
+ * might have to vivify a reference in $x), and so on.
+ *
+ * For example, "$a+1 = 2" would cause mod() to be called with o being
+ * OP_ADD and type being OP_SASSIGN, and would output an error.
+ */
+
 OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
     OP *kid;
+    /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
+    int localize = -1;
 
     if (!o || PL_error_count)
 	return o;
@@ -891,6 +915,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_UNDEF:
+	localize = 0;
 	PL_modcount++;
 	return o;
     case OP_CONST:
@@ -1047,14 +1072,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	break;
 
     case OP_COND_EXPR:
+	localize = 1;
 	for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 	    mod(kid, type);
 	break;
 
     case OP_RV2AV:
     case OP_RV2HV:
-	if (!type && cUNOPo->op_first->op_type != OP_GV)
-	    Perl_croak(aTHX_ "Can't localize through a reference");
 	if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
            PL_modcount = RETURN_UNLIMITED_NUMBER;
 	    return o;		/* Treat \(@foo) like ordinary list. */
@@ -1069,6 +1093,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_HSLICE:
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
+	localize = 1;
 	/* FALL THROUGH */
     case OP_AASSIGN:
     case OP_NEXTSTATE:
@@ -1076,9 +1101,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
        PL_modcount = RETURN_UNLIMITED_NUMBER;
 	break;
     case OP_RV2SV:
-	if (!type && cUNOPo->op_first->op_type != OP_GV)
-	    Perl_croak(aTHX_ "Can't localize through a reference");
 	ref(cUNOPo->op_first, o->op_type);
+	localize = 1;
 	/* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
@@ -1087,7 +1111,11 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
+	PL_modcount++;
+	break;
+
     case OP_AELEMFAST:
+	localize = -1;
 	PL_modcount++;
 	break;
 
@@ -1103,17 +1131,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	/* FALL THROUGH */
     case OP_PADSV:
 	PL_modcount++;
-	if (!type)
-	{   /* XXX DAPM 2002.08.25 tmp assert test */
-	    /* XXX */ assert(av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-	    /* XXX */ assert(*av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-
+	if (!type) /* local() */
 	    Perl_croak(aTHX_ "Can't localize lexical variable %s",
 		 PAD_COMPNAME_PV(o->op_targ));
-	}
 	break;
 
     case OP_PUSHMARK:
+	localize = 0;
 	break;
 
     case OP_KEYS:
@@ -1144,6 +1168,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    o->op_private |= OPpLVAL_DEFER;
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
+	localize = 1;
 	PL_modcount++;
 	break;
 
@@ -1151,11 +1176,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_LEAVE:
     case OP_ENTER:
     case OP_LINESEQ:
+	localize = 0;
 	if (o->op_flags & OPf_KIDS)
 	    mod(cLISTOPo->op_last, type);
 	break;
 
     case OP_NULL:
+	localize = 0;
 	if (o->op_flags & OPf_SPECIAL)		/* do BLOCK */
 	    goto nomod;
 	else if (!(o->op_flags & OPf_KIDS))
@@ -1166,6 +1193,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	}
 	/* FALL THROUGH */
     case OP_LIST:
+	localize = 0;
 	for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 	    mod(kid, type);
 	break;
@@ -1188,10 +1216,21 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     if (type == OP_AASSIGN || type == OP_SASSIGN)
 	o->op_flags |= OPf_SPECIAL|OPf_REF;
-    else if (!type) {
-	o->op_private |= OPpLVAL_INTRO;
-	o->op_flags &= ~OPf_SPECIAL;
-	PL_hints |= HINT_BLOCK_SCOPE;
+    else if (!type) { /* local() */
+	switch (localize) {
+	case 1:
+	    o->op_private |= OPpLVAL_INTRO;
+	    o->op_flags &= ~OPf_SPECIAL;
+	    PL_hints |= HINT_BLOCK_SCOPE;
+	    break;
+	case 0:
+	    break;
+	case -1:
+	    if (ckWARN(WARN_SYNTAX)) {
+		Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+		    "Useless localization of %s", OP_DESC(o));
+	    }
+	}
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
              && type != OP_LEAVESUBLV)
@@ -1641,6 +1680,7 @@ OP *
 Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 {
     OP *o;
+    bool ismatchop = 0;
 
     if (ckWARN(WARN_MISC) &&
       (left->op_type == OP_RV2AV ||
@@ -1665,10 +1705,14 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 	no_bareword_allowed(right);
     }
 
-    if (!(right->op_flags & OPf_STACKED) &&
-       (right->op_type == OP_MATCH ||
-	right->op_type == OP_SUBST ||
-	right->op_type == OP_TRANS)) {
+    ismatchop = right->op_type == OP_MATCH ||
+		right->op_type == OP_SUBST ||
+		right->op_type == OP_TRANS;
+    if (ismatchop && right->op_private & OPpTARGET_MY) {
+	right->op_targ = 0;
+	right->op_private &= ~OPpTARGET_MY;
+    }
+    if (!(right->op_flags & OPf_STACKED) && ismatchop) {
 	right->op_flags |= OPf_STACKED;
 	if (right->op_type != OP_MATCH &&
             ! (right->op_type == OP_TRANS &&
@@ -1705,38 +1749,31 @@ Perl_scope(pTHX_ OP *o)
 	    o->op_type = OP_LEAVE;
 	    o->op_ppaddr = PL_ppaddr[OP_LEAVE];
 	}
-	else {
-	    if (o->op_type == OP_LINESEQ) {
-		OP *kid;
-		o->op_type = OP_SCOPE;
-		o->op_ppaddr = PL_ppaddr[OP_SCOPE];
-		kid = ((LISTOP*)o)->op_first;
-		if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-		    op_null(kid);
-	    }
-	    else
-		o = newLISTOP(OP_SCOPE, 0, o, Nullop);
+	else if (o->op_type == OP_LINESEQ) {
+	    OP *kid;
+	    o->op_type = OP_SCOPE;
+	    o->op_ppaddr = PL_ppaddr[OP_SCOPE];
+	    kid = ((LISTOP*)o)->op_first;
+	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+		op_null(kid);
 	}
+	else
+	    o = newLISTOP(OP_SCOPE, 0, o, Nullop);
     }
     return o;
 }
 
+/* XXX kept for BINCOMPAT only */
 void
 Perl_save_hints(pTHX)
 {
-    SAVEI32(PL_hints);
-    SAVESPTR(GvHV(PL_hintgv));
-    GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
-    SAVEFREESV(GvHV(PL_hintgv));
+    Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
 }
 
 int
 Perl_block_start(pTHX_ int full)
 {
     int retval = PL_savestack_ix;
-    /* If there were syntax errors, don't try to start a block */
-    if (PL_yynerrs) return retval;
-
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
@@ -1757,17 +1794,7 @@ OP*
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
-    line_t copline = PL_copline;
     OP* retval = scalarseq(seq);
-    /* If there were syntax errors, don't try to close a block */
-    if (PL_yynerrs) return retval;
-    if (!seq) {
-	/* scalarseq() gave us an OP_STUB */
-	retval->op_flags |= OPf_PARENS;
-	/* there should be a nextstate in every block */
-	retval = newSTATEOP(0, Nullch, retval);
-	PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
-    }
     LEAVE_SCOPE(floor);
     PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
@@ -1779,7 +1806,15 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
 STATIC OP *
 S_newDEFSVOP(pTHX)
 {
-    return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
+    I32 offset = pad_findmy("$_");
+    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+	return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
+    }
+    else {
+	OP *o = newOP(OP_PADSV, 0);
+	o->op_targ = offset;
+	return o;
+    }
 }
 
 void
@@ -1798,8 +1833,12 @@ Perl_newPROG(pTHX_ OP *o)
 	CALL_PEEP(PL_eval_start);
     }
     else {
-	if (!o)
+	if (o->op_type == OP_STUB) {
+	    PL_comppad_name = 0;
+	    PL_compcv = 0;
+	    FreeOp(o);
 	    return;
+	}
 	PL_main_root = scope(sawparens(scalarvoid(o)));
 	PL_curcop = &PL_compiling;
 	PL_main_start = LINKLIST(PL_main_root);
@@ -1839,14 +1878,31 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 	    && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
 	{
 	    char *s = PL_bufptr;
+	    bool sigil = FALSE;
 
-	    while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s)))
+	    /* some heuristics to detect a potential error */
+	    while (*s && (strchr(", \t\n", *s)))
 		s++;
 
-	    if (*s == ';' || *s == '=')
+	    while (1) {
+		if (*s && strchr("@$%*", *s) && *++s
+		       && (isALNUM(*s) || UTF8_IS_CONTINUED(*s))) {
+		    s++;
+		    sigil = TRUE;
+		    while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)))
+			s++;
+		    while (*s && (strchr(", \t\n", *s)))
+			s++;
+		}
+		else
+		    break;
+	    }
+	    if (sigil && (*s == ';' || *s == '=')) {
 		Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
-			    "Parentheses missing around \"%s\" list",
-			    lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
+				"Parentheses missing around \"%s\" list",
+				lex ? (PL_in_my == KEY_our ? "our" : "my")
+				: "local");
+	    }
 	}
     }
     if (lex)
@@ -1942,19 +1998,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     op_free(o);
     if (type == OP_RV2GV)
 	return newGVOP(OP_GV, 0, (GV*)sv);
-    else {
-	/* try to smush double to int, but don't smush -2.0 to -2 */
-	if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
-	    type != OP_NEGATE)
-	{
-#ifdef PERL_PRESERVE_IVUV
-	    /* Only bother to attempt to fold to IV if
-	       most operators will benefit  */
-	    SvIV_please(sv);
-#endif
-	}
-	return newSVOP(OP_CONST, 0, sv);
-    }
+    return newSVOP(OP_CONST, 0, sv);
 
   nope:
     return o;
@@ -1981,7 +2025,9 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     o->op_type = OP_RV2AV;
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
-    o->op_seq = 0;		/* needs to be revisited in peep() */
+    o->op_flags &= ~OPf_REF;	/* treat \(1..2) like an ordinary list */
+    o->op_flags |= OPf_PARENS;	/* and flatten \(1..2,3) */
+    o->op_opt = 0;		/* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
     op_free(curop);
@@ -2141,7 +2187,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 	    listop->op_last = pushop;
     }
 
-    return (OP*)listop;
+    return CHECKOP(type, listop);
 }
 
 OP *
@@ -2264,13 +2310,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	U8* tend = t + tlen;
 	U8* rend = r + rlen;
 	STRLEN ulen;
-	U32 tfirst = 1;
-	U32 tlast = 0;
-	I32 tdiff;
-	U32 rfirst = 1;
-	U32 rlast = 0;
-	I32 rdiff;
-	I32 diff;
+	UV tfirst = 1;
+	UV tlast = 0;
+	IV tdiff;
+	UV rfirst = 1;
+	UV rlast = 0;
+	IV rdiff;
+	IV diff;
 	I32 none = 0;
 	U32 max = 0;
 	I32 bits;
@@ -2578,7 +2624,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 	PmopSTASH_set(pmop,PL_curstash);
     }
 
-    return (OP*)pmop;
+    return CHECKOP(type, pmop);
 }
 
 OP *
@@ -2625,6 +2671,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 			   : OPf_KIDS);
 	rcop->op_private = 1;
 	rcop->op_other = o;
+	/* /$x/ may cause an eval, since $x might be qr/(?{..})/  */
+	PL_cv_has_eval = 1;
 
 	/* establish postfix order */
 	if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
@@ -2644,7 +2692,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	OP *curop;
 	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = 0;
-	    if (CopLINE(PL_curcop) < PL_multi_end)
+	    if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
 		CopLINE_set(PL_curcop, (line_t)PL_multi_end);
 	}
 	else if (repl->op_type == OP_CONST)
@@ -2656,7 +2704,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 		    if (curop->op_type == OP_GV) {
 			GV *gv = cGVOPx_gv(curop);
 			repl_has_vars = 1;
-			if (strchr("&`'123456789+", *GvENAME(gv)))
+			if (strchr("&`'123456789+-\016\022", *GvENAME(gv)))
 			    break;
 		    }
 		    else if (curop->op_type == OP_RV2CV)
@@ -2803,13 +2851,13 @@ Perl_package(pTHX_ OP *o)
 }
 
 void
-Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
+Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 {
     OP *pack;
     OP *imop;
     OP *veop;
 
-    if (id->op_type != OP_CONST)
+    if (idop->op_type != OP_CONST)
 	Perl_croak(aTHX_ "Module name must be constant");
 
     veop = Nullop;
@@ -2827,8 +2875,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	    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));
+	    /* Make copy of idop so we don't free it twice */
+	    pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
 	    /* Fake up a method call to VERSION */
 	    meth = newSVpvn("VERSION",7);
@@ -2845,14 +2893,14 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
 	imop = arg;		/* no import on explicit () */
-    else if (SvNIOKp(((SVOP*)id)->op_sv)) {
+    else if (SvNIOKp(((SVOP*)idop)->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));
+	/* Make copy of idop so we don't free it twice */
+	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
 	/* Fake up a method call to import/unimport */
 	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
@@ -2872,7 +2920,7 @@ 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, newUNOP(OP_REQUIRE, 0, id)),
+	        newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, idop)),
 	        newSTATEOP(0, Nullch, veop)),
 	    newSTATEOP(0, Nullch, imop) ));
 
@@ -2896,6 +2944,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
+    PL_cop_seqmax++; /* Purely for B::*'s benefit */
 }
 
 /*
@@ -2964,12 +3013,14 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
     }
     {
 	line_t ocopline = PL_copline;
+	COP *ocurcop = PL_curcop;
 	int oexpect = PL_expect;
 
 	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
 		veop, modname, imop);
 	PL_expect = oexpect;
 	PL_copline = ocopline;
+	PL_curcop = ocurcop;
     }
 }
 
@@ -3073,6 +3124,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	    op_free(right);
 	    return Nullop;
 	}
+	/* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
+	if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
+		&& right->op_type == OP_STUB
+		&& (left->op_private & OPpLVAL_INTRO))
+	{
+	    op_free(right);
+	    return left;
+	}
 	curop = list(force_list(left));
 	o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
 	o->op_private = (U8)(0 | (flags >> 8));
@@ -3108,7 +3167,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			     curop->op_type == OP_PADANY)
 		    {
 			if (PAD_COMPNAME_GEN(curop->op_targ)
-						    == PL_generation)
+						    == (STRLEN)PL_generation)
 			    break;
 			PAD_COMPNAME_GEN(curop->op_targ)
 			    				= PL_generation;
@@ -3305,24 +3364,47 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	}
     }
     if (first->op_type == OP_CONST) {
-	if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) {
-	    if (first->op_private & OPpCONST_STRICT)
-		no_bareword_allowed(first);
-	    else
+	if (first->op_private & OPpCONST_STRICT)
+	    no_bareword_allowed(first);
+	else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
 		Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
-	}
-	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
+	if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
+	    (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
+	    (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
 	    op_free(first);
 	    *firstp = Nullop;
+	    if (other->op_type == OP_CONST)
+		other->op_private |= OPpCONST_SHORTCIRCUIT;
 	    return other;
 	}
 	else {
+	    /* check for C<my $x if 0>, or C<my($x,$y) if 0> */
+	    OP *o2 = other;
+	    if ( ! (o2->op_type == OP_LIST
+		    && (( o2 = cUNOPx(o2)->op_first))
+		    && o2->op_type == OP_PUSHMARK
+		    && (( o2 = o2->op_sibling)) )
+	    )
+		o2 = other;
+	    if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
+			|| o2->op_type == OP_PADHV)
+		&& o2->op_private & OPpLVAL_INTRO
+		&& ckWARN(WARN_DEPRECATED))
+	    {
+		Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+			    "Deprecated use of my() in false conditional");
+	    }
+
 	    op_free(other);
 	    *otherp = Nullop;
+	    if (first->op_type == OP_CONST)
+		first->op_private |= OPpCONST_SHORTCIRCUIT;
 	    return first;
 	}
     }
-    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
+    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
+             type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+    {
 	OP *k1 = ((UNOP*)first)->op_first;
 	OP *k2 = k1->op_sibling;
 	OPCODE warnop = 0;
@@ -3380,6 +3462,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     first->op_next = (OP*)logop;
     first->op_sibling = other;
 
+    CHECKOP(type,logop);
+
     o = newUNOP(OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
@@ -3424,6 +3508,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);
 
+    CHECKOP(OP_COND_EXPR, /* that's logop->op_type */
+	    logop);
 
     /* establish postfix order */
     start = LINKLIST(first);
@@ -3522,6 +3608,10 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 	}
     }
 
+    /* if block is null, the next append_elem() would put UNSTACK, a scalar
+     * op, in listop. This is wrong. [perl #27024] */
+    if (!block)
+	block = newOP(OP_NULL, 0);
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
     o = new_logop(OP_AND, 0, &expr, &listop);
 
@@ -3588,11 +3678,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 	if (!next)
 	    next = unstack;
 	cont = append_elem(OP_LINESEQ, cont, unstack);
-	if ((line_t)whileline != NOLINE) {
-	    PL_copline = (line_t)whileline;
-	    cont = append_elem(OP_LINESEQ, cont,
-			       newSTATEOP(0, Nullch, Nullop));
-	}
     }
 
     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
@@ -3645,13 +3730,16 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
     OP *wop;
     PADOFFSET padoff = 0;
     I32 iterflags = 0;
+    I32 iterpflags = 0;
 
     if (sv) {
 	if (sv->op_type == OP_RV2SV) {	/* symbol table variable */
+	    iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
 	    sv->op_type = OP_RV2GV;
 	    sv->op_ppaddr = PL_ppaddr[OP_RV2GV];
 	}
 	else if (sv->op_type == OP_PADSV) { /* private variable */
+	    iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */
 	    padoff = sv->op_targ;
 	    sv->op_targ = 0;
 	    op_free(sv);
@@ -3668,7 +3756,13 @@ 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 {
-	sv = newGVOP(OP_GV, 0, PL_defgv);
+	I32 offset = pad_findmy("$_");
+	if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+	    sv = newGVOP(OP_GV, 0, PL_defgv);
+	}
+	else {
+	    padoff = offset;
+	}
     }
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
 	expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
@@ -3710,6 +3804,9 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
 			       append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
+    /* for my  $x () sets OPpLVAL_INTRO;
+     * for our $x () sets OPpOUR_INTRO */
+    loop->op_private = (U8)iterpflags;
 #ifdef PL_OP_SLAB_ALLOC
     {
 	LOOP *tmp;
@@ -3745,7 +3842,9 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 	op_free(label);
     }
     else {
-	if (label->op_type == OP_ENTERSUB)
+	/* Check whether it's going to be a goto &function */
+	if (label->op_type == OP_ENTERSUB
+		&& !(label->op_flags & OPf_STACKED))
 	    label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
 	o = newUNOP(type, OPf_STACKED, label);
     }
@@ -3821,7 +3920,9 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 	if (name)
 	    Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
 	if (SvPOK(cv))
-	    Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
+	    Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
+	else
+	    Perl_sv_catpvf(aTHX_ msg, ": none");
 	sv_catpv(msg, " vs ");
 	if (p)
 	    Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
@@ -3855,6 +3956,26 @@ Perl_cv_const_sv(pTHX_ CV *cv)
     return (SV*)CvXSUBANY(cv).any_ptr;
 }
 
+/* op_const_sv:  examine an optree to determine whether it's in-lineable.
+ * Can be called in 3 ways:
+ *
+ * !cv
+ * 	look for a single OP_CONST with attached value: return the value
+ *
+ * cv && CvCLONE(cv) && !CvCONST(cv)
+ *
+ * 	examine the clone prototype, and if contains only a single
+ * 	OP_CONST referencing a pad const, or a single PADSV referencing
+ * 	an outer lexical, return a non-zero value to indicate the CV is
+ * 	a candidate for "constizing" at clone time
+ *
+ * cv && CvCONST(cv)
+ *
+ *	We have just cloned an anon prototype that was marked as a const
+ *	candidiate. Try to grab the current value, and in the case of
+ *	PADSV, ignore it if it has multiple references. Return the value.
+ */
+
 SV *
 Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
@@ -3883,26 +4004,31 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 	    return Nullsv;
 	if (type == OP_CONST && cSVOPo->op_sv)
 	    sv = cSVOPo->op_sv;
-	else if ((type == OP_PADSV || type == OP_CONST) && cv) {
+	else if (cv && type == OP_CONST) {
 	    sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
 	    if (!sv)
 		return Nullsv;
-	    if (CvCONST(cv)) {
-		/* We get here only from cv_clone2() while creating a closure.
-		   Copy the const value here instead of in cv_clone2 so that
-		   SvREADONLY_on doesn't lead to problems when leaving
-		   scope.
-		*/
+	}
+	else if (cv && type == OP_PADSV) {
+	    if (CvCONST(cv)) { /* newly cloned anon */
+		sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+		/* the candidate should have 1 ref from this pad and 1 ref
+		 * from the parent */
+		if (!sv || SvREFCNT(sv) != 2)
+		    return Nullsv;
 		sv = newSVsv(sv);
+		SvREADONLY_on(sv);
+		return sv;
+	    }
+	    else {
+		if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+		    sv = &PL_sv_undef; /* an arbitrary non-null value */
 	    }
-	    if (!SvREADONLY(sv) && SvREFCNT(sv) > 1)
-		return Nullsv;
 	}
-	else
+	else {
 	    return Nullsv;
+	}
     }
-    if (sv)
-	SvREADONLY_on(sv);
     return sv;
 }
 
@@ -4095,6 +4221,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	/* transfer PL_compcv to cv */
 	cv_undef(cv);
 	CvFLAGS(cv) = CvFLAGS(PL_compcv);
+	if (!CvWEAKOUTSIDE(cv))
+	    SvREFCNT_dec(CvOUTSIDE(cv));
 	CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
 	CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
 	CvOUTSIDE(PL_compcv) = 0;
@@ -4104,6 +4232,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
 	/* ... before we throw it away */
 	SvREFCNT_dec(PL_compcv);
+	PL_compcv = cv;
 	if (PERLDB_INTER)/* Advice debugger on the new sub. */
 	  ++PL_sub_generation;
     }
@@ -4136,7 +4265,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		else {
 		    /* force display of errors found but not reported */
 		    sv_catpv(ERRSV, not_safe);
-		    Perl_croak(aTHX_ "%s", SvPVx(ERRSV, n_a));
+		    Perl_croak(aTHX_ "%"SVf, ERRSV);
 		}
 	    }
 	}
@@ -4149,6 +4278,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 			     mod(scalarseq(block), OP_LEAVESUBLV));
     }
     else {
+	/* This makes sub {}; work as expected.  */
+	if (block->op_type == OP_STUB) {
+	    op_free(block);
+	    block = newSTATEOP(0, Nullch, 0);
+	}
 	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
@@ -4203,7 +4337,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
 	    goto done;
 
-	if (strEQ(s, "BEGIN")) {
+	if (strEQ(s, "BEGIN") && !PL_error_count) {
 	    I32 oldscope = PL_scopestack_ix;
 	    ENTER;
 	    SAVECOPFILE(&PL_compiling);
@@ -4285,11 +4419,14 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	CopSTASH_set(PL_curcop,stash);
     }
 
-    cv = newXS(name, const_sv_xsub, __FILE__);
+    cv = newXS(name, const_sv_xsub, savepv(CopFILE(PL_curcop)));
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
     sv_setpv((SV*)cv, "");  /* prototype is "" */
 
+    if (stash)
+	CopSTASH_free(PL_curcop);
+
     LEAVE;
 
     return cv;
@@ -4617,13 +4754,17 @@ Perl_ck_bitop(pTHX_ OP *o)
 	 (op) == OP_NE   || (op) == OP_I_NE || \
 	 (op) == OP_NCMP || (op) == OP_I_NCMP)
     o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
-    if (o->op_type == OP_BIT_OR
-	    || o->op_type == OP_BIT_AND
-	    || o->op_type == OP_BIT_XOR)
+    if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
+	    && (o->op_type == OP_BIT_OR
+	     || o->op_type == OP_BIT_AND
+	     || o->op_type == OP_BIT_XOR))
     {
-	OPCODE typfirst = cBINOPo->op_first->op_type;
-	OPCODE typlast  = cBINOPo->op_first->op_sibling->op_type;
-	if (OP_IS_NUMCOMPARE(typfirst) || OP_IS_NUMCOMPARE(typlast))
+	OP * left = cBINOPo->op_first;
+	OP * right = left->op_sibling;
+	if ((OP_IS_NUMCOMPARE(left->op_type) &&
+		(left->op_flags & OPf_PARENS) == 0) ||
+	    (OP_IS_NUMCOMPARE(right->op_type) &&
+		(right->op_flags & OPf_PARENS) == 0))
 	    if (ckWARN(WARN_PRECEDENCE))
 		Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
 			"Possible precedence problem on bitwise %c operator",
@@ -4637,8 +4778,10 @@ Perl_ck_bitop(pTHX_ OP *o)
 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
-    if (cUNOPo->op_first->op_type == OP_CONCAT)
-	o->op_flags |= OPf_STACKED;
+    OP *kid = cUNOPo->op_first;
+    if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
+	    !(kUNOP->op_first->op_flags & OPf_MOD))
+        o->op_flags |= OPf_STACKED;
     return o;
 }
 
@@ -4712,8 +4855,7 @@ Perl_ck_eof(pTHX_ OP *o)
     if (o->op_flags & OPf_KIDS) {
 	if (cLISTOPo->op_first->op_type == OP_STUB) {
 	    op_free(o);
-	    o = newUNOP(type, OPf_SPECIAL,
-		newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
+	    o = newUNOP(type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
 	}
 	return ck_fun(o);
     }
@@ -4731,10 +4873,9 @@ Perl_ck_eval(pTHX_ OP *o)
 	    o->op_flags &= ~OPf_KIDS;
 	    op_null(o);
 	}
-	else if (kid->op_type == OP_LINESEQ) {
+	else if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
 	    LOGOP *enter;
 
-	    kid->op_next = o->op_next;
 	    cUNOPo->op_first = 0;
 	    op_free(o);
 
@@ -4752,8 +4893,10 @@ Perl_ck_eval(pTHX_ OP *o)
 	    enter->op_other = o;
 	    return o;
 	}
-	else
+	else {
 	    scalar((OP*)kid);
+	    PL_cv_has_eval = 1;
+	}
     }
     else {
 	op_free(o);
@@ -4946,12 +5089,19 @@ Perl_ck_ftst(pTHX_ OP *o)
 	    op_free(o);
 	    o = newop;
 	}
+	else {
+	  if ((PL_hints & HINT_FILETEST_ACCESS) &&
+	      OP_IS_FILETEST_ACCESS(o))
+	    o->op_private |= OPpFT_ACCESS;
+	}
+	if (PL_check[kid->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst)
+		&& kid->op_type != OP_STAT && kid->op_type != OP_LSTAT)
+	    o->op_private |= OPpFT_STACKED;
     }
     else {
 	op_free(o);
 	if (type == OP_FTTTY)
-           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
-				SVt_PVIO));
+	    o = newGVOP(type, OPf_REF, PL_stdingv);
 	else
 	    o = newUNOP(type, 0, newDEFSVOP());
     }
@@ -5101,10 +5251,6 @@ Perl_ck_fun(pTHX_ OP *o)
 			     */
 			    priv = OPpDEREF;
 			    if (kid->op_type == OP_PADSV) {
-				/*XXX DAPM 2002.08.25 tmp assert test */
-				/*XXX*/ assert(av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-				/*XXX*/ assert(*av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-
 				name = PAD_COMPNAME_PV(kid->op_targ);
 				/* SvCUR of a pad namesv can't be trusted
 				 * (see PL_generation), so calc its length
@@ -5123,9 +5269,50 @@ Perl_ck_fun(pTHX_ OP *o)
 			    else if (kid->op_type == OP_AELEM
 				     || kid->op_type == OP_HELEM)
 			    {
-				name = "__ANONIO__";
-				len = 10;
-				mod(kid,type);
+				 OP *op;
+
+				 name = 0;
+				 if ((op = ((BINOP*)kid)->op_first)) {
+				      SV *tmpstr = Nullsv;
+				      char *a =
+					   kid->op_type == OP_AELEM ?
+					   "[]" : "{}";
+				      if (((op->op_type == OP_RV2AV) ||
+					   (op->op_type == OP_RV2HV)) &&
+					  (op = ((UNOP*)op)->op_first) &&
+					  (op->op_type == OP_GV)) {
+					   /* packagevar $a[] or $h{} */
+					   GV *gv = cGVOPx_gv(op);
+					   if (gv)
+						tmpstr =
+						     Perl_newSVpvf(aTHX_
+								   "%s%c...%c",
+								   GvNAME(gv),
+								   a[0], a[1]);
+				      }
+				      else if (op->op_type == OP_PADAV
+					       || op->op_type == OP_PADHV) {
+					   /* lexicalvar $a[] or $h{} */
+					   char *padname =
+						PAD_COMPNAME_PV(op->op_targ);
+					   if (padname)
+						tmpstr =
+						     Perl_newSVpvf(aTHX_
+								   "%s%c...%c",
+								   padname + 1,
+								   a[0], a[1]);
+					   
+				      }
+				      if (tmpstr) {
+					   name = SvPV(tmpstr, len);
+					   sv_2mortal(tmpstr);
+				      }
+				 }
+				 if (!name) {
+				      name = "__ANONIO__";
+				      len = 10;
+				 }
+				 mod(kid, type);
 			    }
 			    if (name) {
 				SV *namesv;
@@ -5191,7 +5378,7 @@ Perl_ck_glob(pTHX_ OP *o)
 
 #if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
-    if (!gv) {
+    if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
 	GV *glob_gv;
 	ENTER;
 	Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
@@ -5212,6 +5399,7 @@ Perl_ck_glob(pTHX_ OP *o)
 	o->op_ppaddr = PL_ppaddr[OP_LIST];
 	cLISTOPo->op_first->op_type = OP_PUSHMARK;
 	cLISTOPo->op_first->op_ppaddr = PL_ppaddr[OP_PUSHMARK];
+	cLISTOPo->op_first->op_targ = 0;
 	o = newUNOP(OP_ENTERSUB, OPf_STACKED,
 		    append_elem(OP_LIST, o,
 				scalar(newUNOP(OP_RV2CV, 0,
@@ -5233,6 +5421,7 @@ Perl_ck_grep(pTHX_ OP *o)
     LOGOP *gwop;
     OP *kid;
     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+    I32 offset;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
     NewOp(1101, gwop, 1, LOGOP);
@@ -5241,7 +5430,7 @@ Perl_ck_grep(pTHX_ OP *o)
 	OP* k;
 	o = ck_sort(o);
         kid = cLISTOPo->op_first->op_sibling;
-	for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
+	for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
 	    kid = k;
 	}
 	kid->op_next = (OP*)gwop;
@@ -5264,10 +5453,17 @@ Perl_ck_grep(pTHX_ OP *o)
     gwop->op_ppaddr = PL_ppaddr[type];
     gwop->op_first = listkids(o);
     gwop->op_flags |= OPf_KIDS;
-    gwop->op_private = 1;
     gwop->op_other = LINKLIST(kid);
-    gwop->op_targ = pad_alloc(type, SVs_PADTMP);
     kid->op_next = (OP*)gwop;
+    offset = pad_findmy("$_");
+    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+	o->op_private = gwop->op_private = 0;
+	gwop->op_targ = pad_alloc(type, SVs_PADTMP);
+    }
+    else {
+	o->op_private = gwop->op_private = OPpGREP_LEX;
+	gwop->op_targ = o->op_targ = offset;
+    }
 
     kid = cLISTOPo->op_first->op_sibling;
     if (!kid || !kid->op_sibling)
@@ -5407,13 +5603,34 @@ Perl_ck_sassign(pTHX_ OP *o)
 	    return kid;
 	}
     }
+    /* optimise C<my $x = undef> to C<my $x> */
+    if (kid->op_type == OP_UNDEF) {
+	OP *kkid = kid->op_sibling;
+	if (kkid && kkid->op_type == OP_PADSV
+		&& (kkid->op_private & OPpLVAL_INTRO))
+	{
+	    cLISTOPo->op_first = NULL;
+	    kid->op_sibling = NULL;
+	    op_free(o);
+	    op_free(kid);
+	    return kkid;
+	}
+    }
     return o;
 }
 
 OP *
 Perl_ck_match(pTHX_ OP *o)
 {
-    o->op_private |= OPpRUNTIME;
+    if (o->op_type != OP_QR) {
+	I32 offset = pad_findmy("$_");
+	if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) {
+	    o->op_targ = offset;
+	    o->op_private |= OPpTARGET_MY;
+	}
+    }
+    if (o->op_type == OP_MATCH || o->op_type == OP_QR)
+	o->op_private |= OPpRUNTIME;
     return o;
 }
 
@@ -5472,6 +5689,25 @@ Perl_ck_open(pTHX_ OP *o)
     }
     if (o->op_type == OP_BACKTICK)
 	return o;
+    {
+	 /* In case of three-arg dup open remove strictness
+	  * from the last arg if it is a bareword. */
+	 OP *first = cLISTOPx(o)->op_first; /* The pushmark. */
+	 OP *last  = cLISTOPx(o)->op_last;  /* The bareword. */
+	 OP *oa;
+	 char *mode;
+
+	 if ((last->op_type == OP_CONST) &&		/* The bareword. */
+	     (last->op_private & OPpCONST_BARE) &&
+	     (last->op_private & OPpCONST_STRICT) &&
+	     (oa = first->op_sibling) &&		/* The fh. */
+	     (oa = oa->op_sibling) &&			/* The mode. */
+	     SvPOK(((SVOP*)oa)->op_sv) &&
+	     (mode = SvPVX(((SVOP*)oa)->op_sv)) &&
+	     mode[0] == '>' && mode[1] == '&' &&	/* A dup open. */
+	     (last == oa->op_sibling))			/* The bareword. */
+	      last->op_private &= ~OPpCONST_STRICT;
+    }
     return ck_fun(o);
 }
 
@@ -5584,8 +5820,7 @@ Perl_ck_shift(pTHX_ OP *o)
 
 	op_free(o);
 	argop = newUNOP(OP_RV2AV, 0,
-	    scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
-			   PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+	    scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv)));
 	return newUNOP(type, 0, scalar(argop));
     }
     return scalar(modkids(ck_fun(o), type));
@@ -5805,6 +6040,7 @@ Perl_ck_subr(pTHX_ OP *o)
     I32 contextclass = 0;
     char *e = 0;
     STRLEN n_a;
+    bool delete=0;
 
     o->op_private |= OPpENTERSUB_HASTARG;
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
@@ -5818,9 +6054,24 @@ Perl_ck_subr(pTHX_ OP *o)
 	    cv = GvCVu(gv);
 	    if (!cv)
 		tmpop->op_private |= OPpEARLY_CV;
-	    else if (SvPOK(cv)) {
-		namegv = CvANON(cv) ? gv : CvGV(cv);
-		proto = SvPV((SV*)cv, n_a);
+	    else {
+		if (SvPOK(cv)) {
+		    namegv = CvANON(cv) ? gv : CvGV(cv);
+		    proto = SvPV((SV*)cv, n_a);
+		}
+		if (CvASSERTION(cv)) {
+		    if (PL_hints & HINT_ASSERTING) {
+			if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
+			    o->op_private |= OPpENTERSUB_DB;
+		    }
+		    else {
+			delete=1;
+			if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
+			    Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
+					"Impossible to activate assertion call");
+			}
+		    }
+		}
 	    }
 	}
     }
@@ -5991,8 +6242,8 @@ Perl_ck_subr(pTHX_ OP *o)
 		continue;
 	    default:
 	      oops:
-		Perl_croak(aTHX_ "Malformed prototype for %s: %s",
-			   gv_ename(namegv), SvPV((SV*)cv, n_a));
+		Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
+			   gv_ename(namegv), cv);
 	    }
 	}
 	else
@@ -6004,6 +6255,10 @@ Perl_ck_subr(pTHX_ OP *o)
     if (proto && !optional &&
 	  (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
 	return too_few_arguments(o, gv_ename(namegv));
+    if(delete) {
+	op_free(o);
+	o=newSVOP(OP_CONST, 0, newSViv(0));
+    }
     return o;
 }
 
@@ -6033,6 +6288,18 @@ Perl_ck_trunc(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_unpack(pTHX_ OP *o)
+{
+    OP *kid = cLISTOPo->op_first;
+    if (kid->op_sibling) {
+	kid = kid->op_sibling;
+	if (!kid->op_sibling)
+	    kid->op_sibling = newDEFSVOP();
+    }
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_substr(pTHX_ OP *o)
 {
     o = ck_fun(o);
@@ -6055,35 +6322,34 @@ Perl_peep(pTHX_ register OP *o)
 {
     register OP* oldop = 0;
 
-    if (!o || o->op_seq)
+    if (!o || o->op_opt)
 	return;
     ENTER;
     SAVEOP();
     SAVEVPTR(PL_curcop);
     for (; o; o = o->op_next) {
-	if (o->op_seq)
+	if (o->op_opt)
 	    break;
-	if (!PL_op_seqmax)
-	    PL_op_seqmax++;
 	PL_op = o;
 	switch (o->op_type) {
 	case OP_SETSTATE:
 	case OP_NEXTSTATE:
 	case OP_DBSTATE:
 	    PL_curcop = ((COP*)o);		/* for warnings */
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 
 	case OP_CONST:
 	    if (cSVOPo->op_private & OPpCONST_STRICT)
 		no_bareword_allowed(o);
 #ifdef USE_ITHREADS
+	case OP_METHOD_NAMED:
 	    /* 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);
-		if (SvPADTMP(cSVOPo->op_sv)) {
+		if (o->op_type == OP_CONST && SvPADTMP(cSVOPo->op_sv)) {
 		    /* If op_sv is already a PADTMP then it is being used by
 		     * some pad, so make a copy. */
 		    sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
@@ -6101,7 +6367,7 @@ Perl_peep(pTHX_ register OP *o)
 		o->op_targ = ix;
 	    }
 #endif
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 
 	case OP_CONCAT:
@@ -6119,11 +6385,11 @@ Perl_peep(pTHX_ register OP *o)
 		op_null(o->op_next);
 	    }
 	  ignore_optimization:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 	case OP_STUB:
 	    if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
-		o->op_seq = PL_op_seqmax++;
+		o->op_opt = 1;
 		break; /* Scalar stub must produce undef.  List stub is noop */
 	    }
 	    goto nothin;
@@ -6138,6 +6404,7 @@ Perl_peep(pTHX_ register OP *o)
 	       to peep() from mistakenly concluding that optimisation
 	       has already occurred. This doesn't fix the real problem,
 	       though (See 20010220.007). AMS 20010719 */
+	    /* op_seq functionality is now replaced by op_opt */
 	    if (oldop && o->op_next) {
 		oldop->op_next = o->op_next;
 		continue;
@@ -6151,25 +6418,17 @@ Perl_peep(pTHX_ register OP *o)
 		oldop->op_next = o->op_next;
 		continue;
 	    }
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 
+	case OP_PADAV:
 	case OP_GV:
-	    if (o->op_next->op_type == OP_RV2SV) {
-		if (!(o->op_next->op_private & OPpDEREF)) {
-		    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;
-		    o->op_type = OP_GVSV;
-		    o->op_ppaddr = PL_ppaddr[OP_GVSV];
-		}
-	    }
-	    else if (o->op_next->op_type == OP_RV2AV) {
-		OP* pop = o->op_next->op_next;
+	    if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) {
+		OP* pop = (o->op_type == OP_PADAV) ?
+			    o->op_next : o->op_next->op_next;
 		IV i;
 		if (pop && pop->op_type == OP_CONST &&
-		    (PL_op = pop->op_next) &&
+		    ((PL_op = pop->op_next)) &&
 		    pop->op_next->op_type == OP_AELEM &&
 		    !(pop->op_next->op_private &
 		      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
@@ -6178,16 +6437,36 @@ Perl_peep(pTHX_ register OP *o)
 		    i >= 0)
 		{
 		    GV *gv;
-		    op_null(o->op_next);
+		    if (cSVOPx(pop)->op_private & OPpCONST_STRICT)
+			no_bareword_allowed(pop);
+		    if (o->op_type == OP_GV)
+			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;
 		    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
 		    o->op_private = (U8)i;
-		    gv = cGVOPo_gv;
-		    GvAVn(gv);
+		    if (o->op_type == OP_GV) {
+			gv = cGVOPo_gv;
+			GvAVn(gv);
+		    }
+		    else
+			o->op_flags |= OPf_SPECIAL;
+		    o->op_type = OP_AELEMFAST;
+		}
+    		o->op_opt = 1;
+		break;
+	    }
+
+	    if (o->op_next->op_type == OP_RV2SV) {
+		if (!(o->op_next->op_private & OPpDEREF)) {
+		    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;
+		    o->op_type = OP_GVSV;
+		    o->op_ppaddr = PL_ppaddr[OP_GVSV];
 		}
 	    }
 	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
@@ -6197,8 +6476,8 @@ Perl_peep(pTHX_ register OP *o)
 		    SV *sv = sv_newmortal();
 		    gv_efullname3(sv, gv, Nullch);
 		    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
-				"%s() called too early to check prototype",
-				SvPV_nolen(sv));
+				"%"SVf"() called too early to check prototype",
+				sv);
 		}
 	    }
 	    else if (o->op_next->op_type == OP_READLINE
@@ -6213,7 +6492,7 @@ Perl_peep(pTHX_ register OP *o)
 		op_null(o->op_next);
 	    }
 
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 
 	case OP_MAPWHILE:
@@ -6226,7 +6505,7 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_DORASSIGN:
 	case OP_COND_EXPR:
 	case OP_RANGE:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    while (cLOGOP->op_other->op_type == OP_NULL)
 		cLOGOP->op_other = cLOGOP->op_other->op_next;
 	    peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
@@ -6234,7 +6513,7 @@ Perl_peep(pTHX_ register OP *o)
 
 	case OP_ENTERLOOP:
 	case OP_ENTERITER:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    while (cLOOP->op_redoop->op_type == OP_NULL)
 		cLOOP->op_redoop = cLOOP->op_redoop->op_next;
 	    peep(cLOOP->op_redoop);
@@ -6249,7 +6528,7 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_QR:
 	case OP_MATCH:
 	case OP_SUBST:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    while (cPMOP->op_pmreplstart &&
 		   cPMOP->op_pmreplstart->op_type == OP_NULL)
 		cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
@@ -6257,7 +6536,7 @@ Perl_peep(pTHX_ register OP *o)
 	    break;
 
 	case OP_EXEC:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    if (ckWARN(WARN_SYNTAX) && o->op_next
 		&& o->op_next->op_type == OP_NEXTSTATE) {
 		if (o->op_next->op_sibling &&
@@ -6282,7 +6561,7 @@ Perl_peep(pTHX_ register OP *o)
 	    char *key = NULL;
 	    STRLEN keylen;
 
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 
 	    if (((BINOP*)o)->op_last->op_type != OP_CONST)
 		break;
@@ -6300,8 +6579,98 @@ Perl_peep(pTHX_ register OP *o)
             break;
         }
 
+	case OP_SORT: {
+	    /* make @a = sort @a act in-place */
+
+	    /* will point to RV2AV or PADAV op on LHS/RHS of assign */
+	    OP *oleft, *oright;
+	    OP *o2;
+
+	    o->op_opt = 1;
+
+	    /* check that RHS of sort is a single plain array */
+	    oright = cUNOPo->op_first;
+	    if (!oright || oright->op_type != OP_PUSHMARK)
+		break;
+	    oright = cUNOPx(oright)->op_sibling;
+	    if (!oright)
+		break;
+	    if (oright->op_type == OP_NULL) { /* skip sort block/sub */
+		oright = cUNOPx(oright)->op_sibling;
+	    }
+
+	    if (!oright ||
+		(oright->op_type != OP_RV2AV && oright->op_type != OP_PADAV)
+		|| oright->op_next != o
+		|| (oright->op_private & OPpLVAL_INTRO)
+	    )
+		break;
+
+	    /* o2 follows the chain of op_nexts through the LHS of the
+	     * assign (if any) to the aassign op itself */
+	    o2 = o->op_next;
+	    if (!o2 || o2->op_type != OP_NULL)
+		break;
+	    o2 = o2->op_next;
+	    if (!o2 || o2->op_type != OP_PUSHMARK)
+		break;
+	    o2 = o2->op_next;
+	    if (o2 && o2->op_type == OP_GV)
+		o2 = o2->op_next;
+	    if (!o2
+		|| (o2->op_type != OP_PADAV && o2->op_type != OP_RV2AV)
+		|| (o2->op_private & OPpLVAL_INTRO)
+	    )
+		break;
+	    oleft = o2;
+	    o2 = o2->op_next;
+	    if (!o2 || o2->op_type != OP_NULL)
+		break;
+	    o2 = o2->op_next;
+	    if (!o2 || o2->op_type != OP_AASSIGN
+		    || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID)
+		break;
+
+	    /* check the array is the same on both sides */
+	    if (oleft->op_type == OP_RV2AV) {
+		if (oright->op_type != OP_RV2AV
+		    || !cUNOPx(oright)->op_first
+		    || cUNOPx(oright)->op_first->op_type != OP_GV
+		    ||  cGVOPx_gv(cUNOPx(oleft)->op_first) !=
+		       	cGVOPx_gv(cUNOPx(oright)->op_first)
+		)
+		    break;
+	    }
+	    else if (oright->op_type != OP_PADAV
+		|| oright->op_targ != oleft->op_targ
+	    )
+		break;
+
+	    /* transfer MODishness etc from LHS arg to RHS arg */
+	    oright->op_flags = oleft->op_flags;
+	    o->op_private |= OPpSORT_INPLACE;
+
+	    /* excise push->gv->rv2av->null->aassign */
+	    o2 = o->op_next->op_next;
+	    op_null(o2); /* PUSHMARK */
+	    o2 = o2->op_next;
+	    if (o2->op_type == OP_GV) {
+		op_null(o2); /* GV */
+		o2 = o2->op_next;
+	    }
+	    op_null(o2); /* RV2AV or PADAV */
+	    o2 = o2->op_next->op_next;
+	    op_null(o2); /* AASSIGN */
+
+	    o->op_next = o2->op_next;
+
+	    break;
+	}
+	
+
+
 	default:
-	    o->op_seq = PL_op_seqmax++;
+	    o->op_opt = 1;
 	    break;
 	}
 	oldop = o;