This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
arrange for next() to resume at the unstack op rather than the
[perl5.git] / op.c
diff --git a/op.c b/op.c
index f38b26c..64b8006 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
 /*    op.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -21,7 +21,7 @@
 #include "keywords.h"
 
 /* #define PL_OP_SLAB_ALLOC */
 #include "keywords.h"
 
 /* #define PL_OP_SLAB_ALLOC */
-                                                            
+
 #ifdef PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
 static char    *PL_OpPtr  = NULL;
 #ifdef PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
 static char    *PL_OpPtr  = NULL;
@@ -99,7 +99,7 @@ S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
                     "Bareword \"%s\" not allowed while \"strict subs\" in use",
 {
     qerror(Perl_mess(aTHX_
                     "Bareword \"%s\" not allowed while \"strict subs\" in use",
-                    SvPV_nolen(cSVOPo->op_sv)));
+                    SvPV_nolen(cSVOPo_sv)));
 }
 
 /* "register" allocation */
 }
 
 /* "register" allocation */
@@ -111,11 +111,10 @@ Perl_pad_allocmy(pTHX_ char *name)
     PADOFFSET off;
     SV *sv;
 
     PADOFFSET off;
     SV *sv;
 
-    if (!(
-       PL_in_my == KEY_our ||
-       isALPHA(name[1]) ||
-       (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
-       name[1] == '_' && (int)strlen(name) > 2 ))
+    if (!(PL_in_my == KEY_our ||
+         isALPHA(name[1]) ||
+         (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
+         (name[1] == '_' && (int)strlen(name) > 2)))
     {
        if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
            /* 1999-02-27 mjd@plover.com */
     {
        if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
            /* 1999-02-27 mjd@plover.com */
@@ -138,22 +137,42 @@ Perl_pad_allocmy(pTHX_ char *name)
        }
        yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
        }
        yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
-    if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
+    if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
        SV **svp = AvARRAY(PL_comppad_name);
        SV **svp = AvARRAY(PL_comppad_name);
-       for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
+       HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
+       PADOFFSET top = AvFILLp(PL_comppad_name);
+       for (off = top; off > PL_comppad_name_floor; off--) {
            if ((sv = svp[off])
                && sv != &PL_sv_undef
                && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
            if ((sv = svp[off])
                && sv != &PL_sv_undef
                && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
+               && (PL_in_my != KEY_our
+                   || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
                && strEQ(name, SvPVX(sv)))
            {
                && strEQ(name, SvPVX(sv)))
            {
-               Perl_warner(aTHX_ WARN_UNSAFE,
-                       "\"%s\" variable %s masks earlier declaration in same %s", 
-                       (PL_in_my == KEY_our ? "our" : "my"),
-                       name,
-                       (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+               Perl_warner(aTHX_ WARN_MISC,
+                   "\"%s\" variable %s masks earlier declaration in same %s", 
+                   (PL_in_my == KEY_our ? "our" : "my"),
+                   name,
+                   (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+               --off;
                break;
            }
        }
                break;
            }
        }
+       if (PL_in_my == KEY_our) {
+           do {
+               if ((sv = svp[off])
+                   && sv != &PL_sv_undef
+                   && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
+                   && strEQ(name, SvPVX(sv)))
+               {
+                   Perl_warner(aTHX_ WARN_MISC,
+                       "\"our\" variable %s redeclared", name);
+                   Perl_warner(aTHX_ WARN_MISC,
+                       "\t(Did you mean \"local\" instead of \"our\"?)\n");
+                   break;
+               }
+           } while ( off-- > 0 );
+       }
     }
     off = pad_alloc(OP_PADSV, SVs_PADMY);
     sv = NEWSV(1102,0);
     }
     off = pad_alloc(OP_PADSV, SVs_PADMY);
     sv = NEWSV(1102,0);
@@ -161,15 +180,18 @@ Perl_pad_allocmy(pTHX_ char *name)
     sv_setpv(sv, name);
     if (PL_in_my_stash) {
        if (*name != '$')
     sv_setpv(sv, name);
     if (PL_in_my_stash) {
        if (*name != '$')
-           yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"my\"",
-                        name));
+           yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
+                        name, PL_in_my == KEY_our ? "our" : "my"));
        SvOBJECT_on(sv);
        (void)SvUPGRADE(sv, SVt_PVMG);
        SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
        PL_sv_objcount++;
     }
        SvOBJECT_on(sv);
        (void)SvUPGRADE(sv, SVt_PVMG);
        SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
        PL_sv_objcount++;
     }
-    if (PL_in_my == KEY_our)
+    if (PL_in_my == KEY_our) {
+       (void)SvUPGRADE(sv, SVt_PVGV);
+       GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? (SV*)PL_curstash : (SV*)PL_defstash);
        SvFLAGS(sv) |= SVpad_OUR;
        SvFLAGS(sv) |= SVpad_OUR;
+    }
     av_store(PL_comppad_name, off, sv);
     SvNVX(sv) = (NV)PAD_MAX;
     SvIVX(sv) = 0;                     /* Not yet introduced--see newSTATEOP */
     av_store(PL_comppad_name, off, sv);
     SvNVX(sv) = (NV)PAD_MAX;
     SvIVX(sv) = 0;                     /* Not yet introduced--see newSTATEOP */
@@ -184,6 +206,31 @@ Perl_pad_allocmy(pTHX_ char *name)
     return off;
 }
 
     return off;
 }
 
+STATIC PADOFFSET
+S_pad_addlex(pTHX_ SV *proto_namesv)
+{
+    SV *namesv = NEWSV(1103,0);
+    PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY);
+    sv_upgrade(namesv, SVt_PVNV);
+    sv_setpv(namesv, SvPVX(proto_namesv));
+    av_store(PL_comppad_name, newoff, namesv);
+    SvNVX(namesv) = (NV)PL_curcop->cop_seq;
+    SvIVX(namesv) = PAD_MAX;                   /* A ref, intro immediately */
+    SvFAKE_on(namesv);                         /* A ref, not a real var */
+    if (SvFLAGS(proto_namesv) & SVpad_OUR) {   /* An "our" variable */
+       SvFLAGS(namesv) |= SVpad_OUR;
+       (void)SvUPGRADE(namesv, SVt_PVGV);
+       GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
+    }
+    if (SvOBJECT(proto_namesv)) {              /* A typed var */
+       SvOBJECT_on(namesv);
+       (void)SvUPGRADE(namesv, SVt_PVMG);
+       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
+       PL_sv_objcount++;
+    }
+    return newoff;
+}
+
 #define FINDLEX_NOSEARCH       1               /* don't search outer contexts */
 
 STATIC PADOFFSET
 #define FINDLEX_NOSEARCH       1               /* don't search outer contexts */
 
 STATIC PADOFFSET
@@ -226,25 +273,10 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                    }
                    depth = 1;
                }
                    }
                    depth = 1;
                }
-               oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
+               oldpad = (AV*)AvARRAY(curlist)[depth];
                oldsv = *av_fetch(oldpad, off, TRUE);
                if (!newoff) {          /* Not a mere clone operation. */
                oldsv = *av_fetch(oldpad, off, TRUE);
                if (!newoff) {          /* Not a mere clone operation. */
-                   SV *namesv = NEWSV(1103,0);
-                   newoff = pad_alloc(OP_PADSV, SVs_PADMY);
-                   sv_upgrade(namesv, SVt_PVNV);
-                   sv_setpv(namesv, name);
-                   av_store(PL_comppad_name, newoff, namesv);
-                   SvNVX(namesv) = (NV)PL_curcop->cop_seq;
-                   SvIVX(namesv) = PAD_MAX;    /* A ref, intro immediately */
-                   SvFAKE_on(namesv);          /* A ref, not a real var */
-                   if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */
-                       SvFLAGS(namesv) |= SVpad_OUR;
-                   if (SvOBJECT(sv)) {         /* A typed var */
-                       SvOBJECT_on(namesv);
-                       (void)SvUPGRADE(namesv, SVt_PVMG);
-                       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
-                       PL_sv_objcount++;
-                   }
+                   newoff = pad_addlex(sv);
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(PL_compcv);
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(PL_compcv);
@@ -258,8 +290,23 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                                 bcv && bcv != cv && !CvCLONE(bcv);
                                 bcv = CvOUTSIDE(bcv))
                            {
                                 bcv && bcv != cv && !CvCLONE(bcv);
                                 bcv = CvOUTSIDE(bcv))
                            {
-                               if (CvANON(bcv))
+                               if (CvANON(bcv)) {
+                                   /* install the missing pad entry in intervening
+                                    * nested subs and mark them cloneable.
+                                    * XXX fix pad_foo() to not use globals */
+                                   AV *ocomppad_name = PL_comppad_name;
+                                   AV *ocomppad = PL_comppad;
+                                   SV **ocurpad = PL_curpad;
+                                   AV *padlist = CvPADLIST(bcv);
+                                   PL_comppad_name = (AV*)AvARRAY(padlist)[0];
+                                   PL_comppad = (AV*)AvARRAY(padlist)[1];
+                                   PL_curpad = AvARRAY(PL_comppad);
+                                   pad_addlex(sv);
+                                   PL_comppad_name = ocomppad_name;
+                                   PL_comppad = ocomppad;
+                                   PL_curpad = ocurpad;
                                    CvCLONE_on(bcv);
                                    CvCLONE_on(bcv);
+                               }
                                else {
                                    if (ckWARN(WARN_CLOSURE)
                                        && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
                                else {
                                    if (ckWARN(WARN_CLOSURE)
                                        && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
@@ -308,11 +355,13 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                if (CxREALEVAL(cx))
                    saweval = i;
                break;
                if (CxREALEVAL(cx))
                    saweval = i;
                break;
+           case OP_DOFILE:
            case OP_REQUIRE:
            case OP_REQUIRE:
-               /* require must have its own scope */
+               /* require/do must have their own scope */
                return 0;
            }
            break;
                return 0;
            }
            break;
+       case CXt_FORMAT:
        case CXt_SUB:
            if (!saweval)
                return 0;
        case CXt_SUB:
            if (!saweval)
                return 0;
@@ -442,7 +491,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
                   (sv = names[PL_padix]) && sv != &PL_sv_undef)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
                   (sv = names[PL_padix]) && sv != &PL_sv_undef)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
-           if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
+           if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv))
                break;
        }
        retval = PL_padix;
                break;
        }
        retval = PL_padix;
@@ -450,12 +499,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     SvFLAGS(sv) |= tmptype;
     PL_curpad = AvARRAY(PL_comppad);
 #ifdef USE_THREADS
     SvFLAGS(sv) |= tmptype;
     PL_curpad = AvARRAY(PL_comppad);
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #else
                          (long) retval, PL_op_name[optype]));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #endif /* USE_THREADS */
     return (PADOFFSET)retval;
                          (long) retval, PL_op_name[optype]));
 #endif /* USE_THREADS */
     return (PADOFFSET)retval;
@@ -466,13 +517,14 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
 {
     dTHR;
 #ifdef USE_THREADS
 {
     dTHR;
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
 #else
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     return PL_curpad[po];              /* eventually we'll turn this into a macro */
 }
 #endif /* USE_THREADS */
     return PL_curpad[po];              /* eventually we'll turn this into a macro */
 }
@@ -488,14 +540,19 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
     if (!po)
        Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
 #endif /* USE_THREADS */
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
+    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
        SvPADTMP_off(PL_curpad[po]);
        SvPADTMP_off(PL_curpad[po]);
+#ifdef USE_ITHREADS
+       SvREADONLY_off(PL_curpad[po]);  /* could be a freed constant */
+#endif
+    }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -509,11 +566,12 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
     if (!po)
        Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -538,11 +596,12 @@ Perl_pad_reset(pTHX)
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_THREADS
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" reset\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad)));
 #else
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
-                         (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
+                         PTR2UV(PL_curpad)));
 #endif /* USE_THREADS */
     if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
 #endif /* USE_THREADS */
     if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
@@ -634,6 +693,26 @@ Perl_op_free(pTHX_ OP *o)
     if (!o || o->op_seq == (U16)-1)
        return;
 
     if (!o || o->op_seq == (U16)-1)
        return;
 
+    if (o->op_private & OPpREFCOUNTED) {
+       switch (o->op_type) {
+       case OP_LEAVESUB:
+       case OP_LEAVESUBLV:
+       case OP_LEAVEEVAL:
+       case OP_LEAVE:
+       case OP_SCOPE:
+       case OP_LEAVEWRITE:
+           OP_REFCNT_LOCK;
+           if (OpREFCNT_dec(o)) {
+               OP_REFCNT_UNLOCK;
+               return;
+           }
+           OP_REFCNT_UNLOCK;
+           break;
+       default:
+           break;
+       }
+    }
+
     if (o->op_flags & OPf_KIDS) {
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {
            nextkid = kid->op_sibling; /* Get before next freeing kid */
     if (o->op_flags & OPf_KIDS) {
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {
            nextkid = kid->op_sibling; /* Get before next freeing kid */
@@ -685,8 +764,21 @@ S_op_clear(pTHX_ OP *o)
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
-       SvREFCNT_dec(cGVOPo->op_gv);
-       cGVOPo->op_gv = Nullgv;
+#ifdef USE_ITHREADS
+       if (cPADOPo->op_padix > 0) {
+           if (PL_curpad) {
+               GV *gv = cGVOPo_gv;
+               pad_swipe(cPADOPo->op_padix);
+               /* No GvIN_PAD_off(gv) here, because other references may still
+                * exist on the pad */
+               SvREFCNT_dec(gv);
+           }
+           cPADOPo->op_padix = 0;
+       }
+#else
+       SvREFCNT_dec(cSVOPo->op_sv);
+       cSVOPo->op_sv = Nullsv;
+#endif
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
@@ -711,25 +803,48 @@ S_op_clear(pTHX_ OP *o)
        break;
     case OP_SUBST:
        op_free(cPMOPo->op_pmreplroot);
        break;
     case OP_SUBST:
        op_free(cPMOPo->op_pmreplroot);
-       cPMOPo->op_pmreplroot = Nullop;
-       /* FALL THROUGH */
+       goto clear_pmop;
     case OP_PUSHRE:
     case OP_PUSHRE:
+#ifdef USE_ITHREADS
+       if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+           if (PL_curpad) {
+               GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
+               pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+               /* No GvIN_PAD_off(gv) here, because other references may still
+                * exist on the pad */
+               SvREFCNT_dec(gv);
+           }
+       }
+#else
+       SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+#endif
+       /* FALL THROUGH */
     case OP_MATCH:
     case OP_QR:
     case OP_MATCH:
     case OP_QR:
+clear_pmop:
+       cPMOPo->op_pmreplroot = Nullop;
        ReREFCNT_dec(cPMOPo->op_pmregexp);
        cPMOPo->op_pmregexp = (REGEXP*)NULL;
        break;
     }
 
        ReREFCNT_dec(cPMOPo->op_pmregexp);
        cPMOPo->op_pmregexp = (REGEXP*)NULL;
        break;
     }
 
-    if (o->op_targ > 0)
+    if (o->op_targ > 0) {
        pad_free(o->op_targ);
        pad_free(o->op_targ);
+       o->op_targ = 0;
+    }
 }
 
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
 }
 
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
-    SvREFCNT_dec(cop->cop_filegv);
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(cop));            /* XXXXX share in a pvtable? */
+    Safefree(CopSTASHPV(cop));         /* XXXXX share in a pvtable? */
+#else
+    /* NOTE: COP.cop_stash is not refcounted */
+    SvREFCNT_dec(CopFILEGV(cop));
+#endif
     if (! specialWARN(cop->cop_warnings))
        SvREFCNT_dec(cop->cop_warnings);
 }
     if (! specialWARN(cop->cop_warnings))
        SvREFCNT_dec(cop->cop_warnings);
 }
@@ -790,12 +905,12 @@ S_scalarboolean(pTHX_ OP *o)
     if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
        dTHR;
        if (ckWARN(WARN_SYNTAX)) {
     if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
        dTHR;
        if (ckWARN(WARN_SYNTAX)) {
-           line_t oldline = PL_curcop->cop_line;
+           line_t oldline = CopLINE(PL_curcop);
 
            if (PL_copline != NOLINE)
 
            if (PL_copline != NOLINE)
-               PL_curcop->cop_line = PL_copline;
+               CopLINE_set(PL_curcop, PL_copline);
            Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
            Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
-           PL_curcop->cop_line = oldline;
+           CopLINE_set(PL_curcop, oldline);
        }
     }
     return scalar(o);
        }
     }
     return scalar(o);
@@ -809,12 +924,10 @@ Perl_scalar(pTHX_ OP *o)
     /* assumes no premature commitment */
     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
         || o->op_type == OP_RETURN)
     /* assumes no premature commitment */
     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
         || o->op_type == OP_RETURN)
+    {
        return o;
        return o;
+    }
 
 
-    if ((o->op_private & OPpTARGET_MY)
-       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
-       return scalar(o);                       /* As if inside SASSIGN */
-    
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
 
     switch (o->op_type) {
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
 
     switch (o->op_type) {
@@ -849,7 +962,7 @@ Perl_scalar(pTHX_ OP *o)
     case OP_LEAVETRY:
        kid = cLISTOPo->op_first;
        scalar(kid);
     case OP_LEAVETRY:
        kid = cLISTOPo->op_first;
        scalar(kid);
-       while (kid = kid->op_sibling) {
+       while ((kid = kid->op_sibling)) {
            if (kid->op_sibling)
                scalarvoid(kid);
            else
            if (kid->op_sibling)
                scalarvoid(kid);
            else
@@ -895,11 +1008,15 @@ Perl_scalarvoid(pTHX_ OP *o)
     want = o->op_flags & OPf_WANT;
     if ((want && want != OPf_WANT_SCALAR) || PL_error_count
         || o->op_type == OP_RETURN)
     want = o->op_flags & OPf_WANT;
     if ((want && want != OPf_WANT_SCALAR) || PL_error_count
         || o->op_type == OP_RETURN)
+    {
        return o;
        return o;
+    }
 
     if ((o->op_private & OPpTARGET_MY)
 
     if ((o->op_private & OPpTARGET_MY)
-       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+    {
        return scalar(o);                       /* As if inside SASSIGN */
        return scalar(o);                       /* As if inside SASSIGN */
+    }
     
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
 
     
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
 
@@ -984,7 +1101,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_GGRGID:
     case OP_GETLOGIN:
       func_ops:
     case OP_GGRGID:
     case OP_GETLOGIN:
       func_ops:
-       if (!(o->op_private & OPpLVAL_INTRO))
+       if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
            useless = PL_op_desc[o->op_type];
        break;
 
            useless = PL_op_desc[o->op_type];
        break;
 
@@ -992,13 +1109,13 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_RV2SV:
     case OP_RV2AV:
     case OP_RV2HV:
     case OP_RV2SV:
     case OP_RV2AV:
     case OP_RV2HV:
-       if (!(o->op_private & OPpLVAL_INTRO) &&
+       if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
                (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
            useless = "a variable";
        break;
 
     case OP_CONST:
                (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
            useless = "a variable";
        break;
 
     case OP_CONST:
-       sv = cSVOPo->op_sv;
+       sv = cSVOPo_sv;
        if (cSVOPo->op_private & OPpCONST_STRICT)
            no_bareword_allowed(o);
        else {
        if (cSVOPo->op_private & OPpCONST_STRICT)
            no_bareword_allowed(o);
        else {
@@ -1097,11 +1214,15 @@ Perl_list(pTHX_ OP *o)
     /* assumes no premature commitment */
     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
         || o->op_type == OP_RETURN)
     /* assumes no premature commitment */
     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
         || o->op_type == OP_RETURN)
+    {
        return o;
        return o;
+    }
 
     if ((o->op_private & OPpTARGET_MY)
 
     if ((o->op_private & OPpTARGET_MY)
-       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+    {
        return o;                               /* As if inside SASSIGN */
        return o;                               /* As if inside SASSIGN */
+    }
     
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
 
     
     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
 
@@ -1134,7 +1255,7 @@ Perl_list(pTHX_ OP *o)
     case OP_LEAVETRY:
        kid = cLISTOPo->op_first;
        list(kid);
     case OP_LEAVETRY:
        kid = cLISTOPo->op_first;
        list(kid);
-       while (kid = kid->op_sibling) {
+       while ((kid = kid->op_sibling)) {
            if (kid->op_sibling)
                scalarvoid(kid);
            else
            if (kid->op_sibling)
                scalarvoid(kid);
            else
@@ -1204,15 +1325,16 @@ Perl_mod(pTHX_ OP *o, I32 type)
 {
     dTHR;
     OP *kid;
 {
     dTHR;
     OP *kid;
-    SV *sv;
     STRLEN n_a;
 
     if (!o || PL_error_count)
        return o;
 
     if ((o->op_private & OPpTARGET_MY)
     STRLEN n_a;
 
     if (!o || PL_error_count)
        return o;
 
     if ((o->op_private & OPpTARGET_MY)
-       && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+       && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+    {
        return o;
        return o;
+    }
     
     switch (o->op_type) {
     case OP_UNDEF:
     
     switch (o->op_type) {
     case OP_UNDEF:
@@ -1222,7 +1344,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        if (!(o->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
        if (!(o->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
-           PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
+           PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
            PL_eval_start = 0;
        }
        else if (!type) {
            PL_eval_start = 0;
        }
        else if (!type) {
@@ -1249,7 +1371,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        }
        else {                          /* lvalue subroutine call */
            o->op_private |= OPpLVAL_INTRO;
        }
        else {                          /* lvalue subroutine call */
            o->op_private |= OPpLVAL_INTRO;
-           if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+           if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
                /* Backward compatibility mode: */
                o->op_private |= OPpENTERSUB_INARGS;
                break;
                /* Backward compatibility mode: */
                o->op_private |= OPpENTERSUB_INARGS;
                break;
@@ -1275,18 +1397,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    if (kid->op_type == OP_METHOD_NAMED
                        || kid->op_type == OP_METHOD)
                    {
                    if (kid->op_type == OP_METHOD_NAMED
                        || kid->op_type == OP_METHOD)
                    {
-                       OP *newop;
+                       UNOP *newop;
 
                        if (kid->op_sibling || kid->op_next != kid) {
                            yyerror("panic: unexpected optree near method call");
                            break;
                        }
                        
 
                        if (kid->op_sibling || kid->op_next != kid) {
                            yyerror("panic: unexpected optree near method call");
                            break;
                        }
                        
-                       NewOp(1101, newop, 1, OP);
+                       NewOp(1101, newop, 1, UNOP);
                        newop->op_type = OP_RV2CV;
                        newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
                        newop->op_type = OP_RV2CV;
                        newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
-                       newop->op_next = newop;
-                       kid->op_sibling = newop;
+                       newop->op_first = Nullop;
+                        newop->op_next = (OP*)newop;
+                       kid->op_sibling = (OP*)newop;
                        newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }
                        newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }
@@ -1325,7 +1448,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    break;
                }
                
                    break;
                }
                
-               cv = GvCV(kGVOP->op_gv);
+               cv = GvCV(kGVOP_gv);
                if (!cv) 
                    goto restore_2cv;
                if (CvLVALUE(cv))
                if (!cv) 
                    goto restore_2cv;
                if (CvLVALUE(cv))
@@ -1593,7 +1716,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_ENTERSUB:
 
     switch (o->op_type) {
     case OP_ENTERSUB:
-       if ((type == OP_DEFINED || type == OP_LOCK) &&
+       if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
            !(o->op_flags & OPf_STACKED)) {
            o->op_type = OP_RV2CV;             /* entersub => rv2cv */
            o->op_ppaddr = PL_ppaddr[OP_RV2CV];
            !(o->op_flags & OPf_STACKED)) {
            o->op_type = OP_RV2CV;             /* entersub => rv2cv */
            o->op_ppaddr = PL_ppaddr[OP_RV2CV];
@@ -1698,7 +1821,6 @@ S_dup_attrlist(pTHX_ OP *o)
 STATIC void
 S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
 STATIC void
 S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
-    OP *modname;       /* for 'use' */
     SV *stashsv;
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     SV *stashsv;
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
@@ -1708,19 +1830,18 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
        stashsv = newSVpv(HvNAME(stash), 0);
     else
        stashsv = &PL_sv_no;
        stashsv = newSVpv(HvNAME(stash), 0);
     else
        stashsv = &PL_sv_no;
+
 #define ATTRSMODULE "attributes"
 #define ATTRSMODULE "attributes"
-    modname = newSVOP(OP_CONST, 0,
-                     newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
-    modname->op_private |= OPpCONST_BARE;
-    /* that flag is required to make 'use' work right */
-    utilize(1, start_subparse(FALSE, 0),
-           Nullop, /* version */
-           modname,
-           prepend_elem(OP_LIST,
-                        newSVOP(OP_CONST, 0, stashsv),
-                        prepend_elem(OP_LIST,
-                                     newSVOP(OP_CONST, 0, newRV(target)),
-                                     dup_attrlist(attrs))));
+
+    Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
+                    newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+                    Nullsv,
+                    prepend_elem(OP_LIST,
+                                 newSVOP(OP_CONST, 0, stashsv),
+                                 prepend_elem(OP_LIST,
+                                              newSVOP(OP_CONST, 0,
+                                                      newRV(target)),
+                                              dup_attrlist(attrs))));
     LEAVE;
 }
 
     LEAVE;
 }
 
@@ -1742,13 +1863,16 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
     } else if (type == OP_RV2SV ||     /* "our" declaration */
               type == OP_RV2AV ||
               type == OP_RV2HV) { /* XXX does this let anything illegal in? */
     } else if (type == OP_RV2SV ||     /* "our" declaration */
               type == OP_RV2AV ||
               type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+       o->op_private |= OPpOUR_INTRO;
        return o;
     } else if (type != OP_PADSV &&
             type != OP_PADAV &&
             type != OP_PADHV &&
             type != OP_PUSHMARK)
     {
        return o;
     } else if (type != OP_PADSV &&
             type != OP_PADAV &&
             type != OP_PADHV &&
             type != OP_PUSHMARK)
     {
-       yyerror(Perl_form(aTHX_ "Can't declare %s in my", PL_op_desc[o->op_type]));
+       yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
+                         PL_op_desc[o->op_type],
+                         PL_in_my == KEY_our ? "our" : "my"));
        return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
        return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
@@ -1756,6 +1880,9 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
        SV *padsv;
        SV **namesvp;
 
        SV *padsv;
        SV **namesvp;
 
+       PL_in_my = FALSE;
+       PL_in_my_stash = Nullhv;
+
        /* check for C<my Dog $spot> when deciding package */
        namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
        if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
        /* 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)))
@@ -1775,11 +1902,12 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 {
     if (o->op_flags & OPf_PARENS)
        list(o);
 {
     if (o->op_flags & OPf_PARENS)
        list(o);
-    PL_in_my = FALSE;
-    PL_in_my_stash = Nullhv;
     if (attrs)
        SAVEFREEOP(attrs);
     if (attrs)
        SAVEFREEOP(attrs);
-    return my_kid(o, attrs);
+    o = my_kid(o, attrs);
+    PL_in_my = FALSE;
+    PL_in_my_stash = Nullhv;
+    return o;
 }
 
 OP *
 }
 
 OP *
@@ -1802,7 +1930,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     dTHR;
     OP *o;
 
     dTHR;
     OP *o;
 
-    if (ckWARN(WARN_UNSAFE) &&
+    if (ckWARN(WARN_MISC) &&
       (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
       (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
@@ -1810,10 +1938,10 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
       char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
       char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
-      char *sample = ((left->op_type == OP_RV2AV ||
-                       left->op_type == OP_PADAV)
-                      ? "@array" : "%hash");
-      Perl_warner(aTHX_ WARN_UNSAFE,
+      const char *sample = ((left->op_type == OP_RV2AV ||
+                            left->op_type == OP_PADAV)
+                           ? "@array" : "%hash");
+      Perl_warner(aTHX_ WARN_MISC,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
     }
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
     }
@@ -1887,12 +2015,11 @@ Perl_block_start(pTHX_ int full)
     int retval = PL_savestack_ix;
 
     SAVEI32(PL_comppad_name_floor);
     int retval = PL_savestack_ix;
 
     SAVEI32(PL_comppad_name_floor);
-    if (full) {
-       if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
-           PL_comppad_name_floor = PL_comppad_name_fill;
-       else
-           PL_comppad_name_floor = 0;
-    }
+    PL_comppad_name_floor = AvFILLp(PL_comppad_name);
+    if (full)
+       PL_comppad_name_fill = PL_comppad_name_floor;
+    if (PL_comppad_name_floor < 0)
+       PL_comppad_name_floor = 0;
     SAVEI32(PL_min_intro_pending);
     SAVEI32(PL_max_intro_pending);
     PL_min_intro_pending = 0;
     SAVEI32(PL_min_intro_pending);
     SAVEI32(PL_max_intro_pending);
     PL_min_intro_pending = 0;
@@ -1902,13 +2029,11 @@ Perl_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     PL_pad_reset_pending = FALSE;
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVEPPTR(PL_compiling.cop_warnings); 
+    SAVESPTR(PL_compiling.cop_warnings); 
     if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
     }
     if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
     }
-
-
     return retval;
 }
 
     return retval;
 }
 
@@ -1951,6 +2076,8 @@ Perl_newPROG(pTHX_ OP *o)
                               ((PL_in_eval & EVAL_KEEPERR)
                                ? OPf_SPECIAL : 0), o);
        PL_eval_start = linklist(PL_eval_root);
                               ((PL_in_eval & EVAL_KEEPERR)
                                ? OPf_SPECIAL : 0), o);
        PL_eval_start = linklist(PL_eval_root);
+       PL_eval_root->op_private |= OPpREFCOUNTED;
+       OpREFCNT_set(PL_eval_root, 1);
        PL_eval_root->op_next = 0;
        peep(PL_eval_start);
     }
        PL_eval_root->op_next = 0;
        peep(PL_eval_start);
     }
@@ -1960,6 +2087,8 @@ Perl_newPROG(pTHX_ OP *o)
        PL_main_root = scope(sawparens(scalarvoid(o)));
        PL_curcop = &PL_compiling;
        PL_main_start = LINKLIST(PL_main_root);
        PL_main_root = scope(sawparens(scalarvoid(o)));
        PL_curcop = &PL_compiling;
        PL_main_start = LINKLIST(PL_main_root);
+       PL_main_root->op_private |= OPpREFCOUNTED;
+       OpREFCNT_set(PL_main_root, 1);
        PL_main_root->op_next = 0;
        peep(PL_main_start);
        PL_compcv = 0;
        PL_main_root->op_next = 0;
        peep(PL_main_start);
        PL_compcv = 0;
@@ -1970,7 +2099,7 @@ Perl_newPROG(pTHX_ OP *o)
            if (cv) {
                dSP;
                PUSHMARK(SP);
            if (cv) {
                dSP;
                PUSHMARK(SP);
-               XPUSHs((SV*)PL_compiling.cop_filegv);
+               XPUSHs((SV*)CopFILEGV(&PL_compiling));
                PUTBACK;
                call_sv((SV*)cv, G_DISCARD);
            }
                PUTBACK;
                call_sv((SV*)cv, G_DISCARD);
            }
@@ -1989,16 +2118,18 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            char *s;
            for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
            char *s;
            for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
-               Perl_warner(aTHX_ WARN_PARENTHESIS, "Parentheses missing around \"%s\" list",
-                               lex ? "my" : "local");
+               Perl_warner(aTHX_ WARN_PARENTHESIS,
+                           "Parentheses missing around \"%s\" list",
+                           lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
        }
     }
        }
     }
-    PL_in_my = FALSE;
-    PL_in_my_stash = Nullhv;
     if (lex)
     if (lex)
-       return my(o);
+       o = my(o);
     else
     else
-       return mod(o, OP_NULL);         /* a bit kludgey */
+       o = mod(o, OP_NULL);            /* a bit kludgey */
+    PL_in_my = FALSE;
+    PL_in_my_stash = Nullhv;
+    return o;
 }
 
 OP *
 }
 
 OP *
@@ -2112,8 +2243,12 @@ Perl_fold_constants(pTHX_ register OP *o)
        return o;
 
     if (!(PL_hints & HINT_INTEGER)) {
        return o;
 
     if (!(PL_hints & HINT_INTEGER)) {
-       if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
+       if (type == OP_MODULO
+           || type == OP_DIVIDE
+           || !(o->op_flags & OPf_KIDS))
+       {
            return o;
            return o;
+       }
 
        for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
            if (curop->op_type == OP_CONST) {
 
        for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
            if (curop->op_type == OP_CONST) {
@@ -2144,6 +2279,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
+    peep(curop);
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
@@ -2202,8 +2338,11 @@ Perl_append_elem(pTHX_ I32 type, OP *first, OP *last)
     if (!last)
        return first;
 
     if (!last)
        return first;
 
-    if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
-           return newLISTOP(type, 0, first, last);
+    if (first->op_type != type
+       || (type == OP_LIST && (first->op_flags & OPf_PARENS)))
+    {
+       return newLISTOP(type, 0, first, last);
+    }
 
     if (first->op_flags & OPf_KIDS)
        ((LISTOP*)first)->op_last->op_sibling = last;
 
     if (first->op_flags & OPf_KIDS)
        ((LISTOP*)first)->op_last->op_sibling = last;
@@ -2449,12 +2588,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        I32 grows = 0;
        I32 havefinal = 0;
        U32 final;
        I32 grows = 0;
        I32 havefinal = 0;
        U32 final;
-       HV *hv;
        I32 from_utf    = o->op_private & OPpTRANS_FROM_UTF;
        I32 to_utf      = o->op_private & OPpTRANS_TO_UTF;
 
        if (complement) {
        I32 from_utf    = o->op_private & OPpTRANS_FROM_UTF;
        I32 to_utf      = o->op_private & OPpTRANS_TO_UTF;
 
        if (complement) {
-           U8 tmpbuf[10];
+           U8 tmpbuf[UTF8_MAXLEN];
            U8** cp;
            UV nextmin = 0;
            New(1109, cp, tlen, U8*);
            U8** cp;
            UV nextmin = 0;
            New(1109, cp, tlen, U8*);
@@ -2556,15 +2694,19 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            if (rfirst == 0xffffffff) {
                diff = tdiff;   /* oops, pretend rdiff is infinite */
                if (diff > 0)
            if (rfirst == 0xffffffff) {
                diff = tdiff;   /* oops, pretend rdiff is infinite */
                if (diff > 0)
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\tXXXX\n",
+                                  (long)tfirst, (long)tlast);
                else
                else
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t\tXXXX\n", tfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\tXXXX\n", (long)tfirst);
            }
            else {
                if (diff > 0)
            }
            else {
                if (diff > 0)
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\t%04lx\n",
+                                  (long)tfirst, (long)(tfirst + diff),
+                                  (long)rfirst);
                else
                else
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t\t%04x\n", tfirst, rfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\t%04lx\n",
+                                  (long)tfirst, (long)rfirst);
 
                if (rfirst + diff > max)
                    max = rfirst + diff;
 
                if (rfirst + diff > max)
                    max = rfirst + diff;
@@ -2604,7 +2746,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            SvREFCNT_dec(transv);
 
        if (!del && havefinal)
            SvREFCNT_dec(transv);
 
        if (!del && havefinal)
-           (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5, newSViv((IV)final), 0);
+           (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
+                          newSVuv((UV)final), 0);
 
        if (grows && to_utf)
            o->op_private |= OPpTRANS_GROWS;
 
        if (grows && to_utf)
            o->op_private |= OPpTRANS_GROWS;
@@ -2711,12 +2854,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
            p = SvPV(pat, plen);
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
            p = SvPV(pat, plen);
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
+       if ((PL_hints & HINT_UTF8) || (SvUTF8(pat) && !(PL_hints & HINT_BYTE)))
+           pm->op_pmdynflags |= PMdf_UTF8;
        pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
        if (strEQ("\\s+", pm->op_pmregexp->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
     }
     else {
        pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
        if (strEQ("\\s+", pm->op_pmregexp->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
     }
     else {
+       if (PL_hints & HINT_UTF8)
+           pm->op_pmdynflags |= PMdf_UTF8;
        if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
            expr = newUNOP((!(PL_hints & HINT_RE_EVAL) 
                            ? OP_REGCRESET
        if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
            expr = newUNOP((!(PL_hints & HINT_RE_EVAL) 
                            ? OP_REGCRESET
@@ -2750,8 +2897,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        OP *curop;
        if (pm->op_pmflags & PMf_EVAL) {
            curop = 0;
        OP *curop;
        if (pm->op_pmflags & PMf_EVAL) {
            curop = 0;
-           if (PL_curcop->cop_line < PL_multi_end)
-               PL_curcop->cop_line = PL_multi_end;
+           if (CopLINE(PL_curcop) < PL_multi_end)
+               CopLINE_set(PL_curcop, PL_multi_end);
        }
 #ifdef USE_THREADS
        else if (repl->op_type == OP_THREADSV
        }
 #ifdef USE_THREADS
        else if (repl->op_type == OP_THREADSV
@@ -2775,7 +2922,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
                    }
 #else
                    if (curop->op_type == OP_GV) {
                    }
 #else
                    if (curop->op_type == OP_GV) {
-                       GV *gv = ((GVOP*)curop)->op_gv;
+                       GV *gv = cGVOPx_gv(curop);
                        repl_has_vars = 1;
                        if (strchr("&`'123456789+", *GvENAME(gv)))
                            break;
                        repl_has_vars = 1;
                        if (strchr("&`'123456789+", *GvENAME(gv)))
                            break;
@@ -2856,21 +3003,35 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 }
 
 OP *
 }
 
 OP *
+Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
+{
+    PADOP *padop;
+    NewOp(1101, padop, 1, PADOP);
+    padop->op_type = type;
+    padop->op_ppaddr = PL_ppaddr[type];
+    padop->op_padix = pad_alloc(type, SVs_PADTMP);
+    SvREFCNT_dec(PL_curpad[padop->op_padix]);
+    PL_curpad[padop->op_padix] = sv;
+    SvPADTMP_on(sv);
+    padop->op_next = (OP*)padop;
+    padop->op_flags = flags;
+    if (PL_opargs[type] & OA_RETSCALAR)
+       scalar((OP*)padop);
+    if (PL_opargs[type] & OA_TARGET)
+       padop->op_targ = pad_alloc(type, SVs_PADTMP);
+    return CHECKOP(type, padop);
+}
+
+OP *
 Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 {
     dTHR;
 Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 {
     dTHR;
-    GVOP *gvop;
-    NewOp(1101, gvop, 1, GVOP);
-    gvop->op_type = type;
-    gvop->op_ppaddr = PL_ppaddr[type];
-    gvop->op_gv = (GV*)SvREFCNT_inc(gv);
-    gvop->op_next = (OP*)gvop;
-    gvop->op_flags = flags;
-    if (PL_opargs[type] & OA_RETSCALAR)
-       scalar((OP*)gvop);
-    if (PL_opargs[type] & OA_TARGET)
-       gvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return CHECKOP(type, gvop);
+#ifdef USE_ITHREADS
+    GvIN_PAD_on(gv);
+    return newPADOP(type, flags, SvREFCNT_inc(gv));
+#else
+    return newSVOP(type, flags, SvREFCNT_inc(gv));
+#endif
 }
 
 OP *
 }
 
 OP *
@@ -2920,7 +3081,6 @@ void
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
-    OP *meth;
     OP *rqop;
     OP *imop;
     OP *veop;
     OP *rqop;
     OP *imop;
     OP *veop;
@@ -2931,45 +3091,55 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 
     veop = Nullop;
 
 
     veop = Nullop;
 
-    if(version != Nullop) {
+    if (version != Nullop) {
        SV *vesv = ((SVOP*)version)->op_sv;
 
        SV *vesv = ((SVOP*)version)->op_sv;
 
-       if (arg == Nullop && !SvNIOK(vesv)) {
+       if (arg == Nullop && !SvNIOKp(vesv)) {
            arg = version;
        }
        else {
            OP *pack;
            arg = version;
        }
        else {
            OP *pack;
+           SV *meth;
 
 
-           if (version->op_type != OP_CONST || !SvNIOK(vesv))
+           if (version->op_type != OP_CONST || !SvNIOKp(vesv))
                Perl_croak(aTHX_ "Version number must be constant number");
 
            /* Make copy of id so we don't free it twice */
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
            /* Fake up a method call to VERSION */
                Perl_croak(aTHX_ "Version number must be constant number");
 
            /* Make copy of id so we don't free it twice */
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
            /* Fake up a method call to VERSION */
+           meth = newSVpvn("VERSION",7);
+           sv_upgrade(meth, SVt_PVIV);
+           (void)SvIOK_on(meth);
+           PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            append_elem(OP_LIST,
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            append_elem(OP_LIST,
-                           prepend_elem(OP_LIST, pack, list(version)),
-                           newSVOP(OP_METHOD_NAMED, 0,
-                                   newSVpvn("VERSION", 7))));
+                                       prepend_elem(OP_LIST, pack, list(version)),
+                                       newSVOP(OP_METHOD_NAMED, 0, meth)));
        }
     }
 
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
        }
     }
 
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
-    else if(SvNIOK(((SVOP*)id)->op_sv)) {
+    else if (SvNIOKp(((SVOP*)id)->op_sv)) {
        imop = Nullop;          /* use 5.0; */
     }
     else {
        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 id so we don't free it twice */
        pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
+
+       /* Fake up a method call to import/unimport */
+       meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);;
+       sv_upgrade(meth, SVt_PVIV);
+       (void)SvIOK_on(meth);
+       PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
-                   append_elem(OP_LIST,
-                       prepend_elem(OP_LIST, pack, list(arg)),
-                       newSVOP(OP_METHOD_NAMED, 0,
-                               aver ? newSVpvn("import", 6)
-                                    : newSVpvn("unimport", 8))));
+                      append_elem(OP_LIST,
+                                  prepend_elem(OP_LIST, pack, list(arg)),
+                                  newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
     /* Fake up a require, handle override, if any */
     }
 
     /* Fake up a require, handle override, if any */
@@ -3004,6 +3174,58 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     PL_expect = XSTATE;
 }
 
     PL_expect = XSTATE;
 }
 
+void
+Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
+{
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+
+#ifdef PERL_IMPLICIT_CONTEXT
+void
+Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...)
+{
+    dTHX;
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+#endif
+
+void
+Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
+{
+    OP *modname, *veop, *imop;
+
+    modname = newSVOP(OP_CONST, 0, name);
+    modname->op_private |= OPpCONST_BARE;
+    if (ver) {
+       veop = newSVOP(OP_CONST, 0, ver);
+    }
+    else
+       veop = Nullop;
+    if (flags & PERL_LOADMOD_NOIMPORT) {
+       imop = sawparens(newNULLLIST());
+    }
+    else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+       imop = va_arg(*args, OP*);
+    }
+    else {
+       SV *sv;
+       imop = Nullop;
+       sv = va_arg(*args, SV*);
+       while (sv) {
+           imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+           sv = va_arg(*args, SV*);
+       }
+    }
+    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+           veop, modname, imop);
+}
+
 OP *
 Perl_dofile(pTHX_ OP *term)
 {
 OP *
 Perl_dofile(pTHX_ OP *term)
 {
@@ -3088,6 +3310,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 
     if (list_assignment(left)) {
        dTHR;
 
     if (list_assignment(left)) {
        dTHR;
+       OP *curop;
+
        PL_modcount = 0;
        PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
        left = mod(left, OP_AASSIGN);
        PL_modcount = 0;
        PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
        left = mod(left, OP_AASSIGN);
@@ -3098,18 +3322,25 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
            op_free(right);
            return Nullop;
        }
            op_free(right);
            return Nullop;
        }
-       o = newBINOP(OP_AASSIGN, flags,
-               list(force_list(right)),
-               list(force_list(left)) );
+       curop = list(force_list(left));
+       o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
        o->op_private = 0 | (flags >> 8);
        o->op_private = 0 | (flags >> 8);
+       for (curop = ((LISTOP*)curop)->op_first;
+            curop; curop = curop->op_sibling)
+       {
+           if (curop->op_type == OP_RV2HV &&
+               ((UNOP*)curop)->op_first->op_type != OP_GV) {
+               o->op_private |= OPpASSIGN_HASH;
+               break;
+           }
+       }
        if (!(left->op_private & OPpLVAL_INTRO)) {
        if (!(left->op_private & OPpLVAL_INTRO)) {
-           OP *curop;
            OP *lastop = o;
            PL_generation++;
            for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
                if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
                    if (curop->op_type == OP_GV) {
            OP *lastop = o;
            PL_generation++;
            for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
                if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
                    if (curop->op_type == OP_GV) {
-                       GV *gv = ((GVOP*)curop)->op_gv;
+                       GV *gv = cGVOPx_gv(curop);
                        if (gv == PL_defgv || SvCUR(gv) == PL_generation)
                            break;
                        SvCUR(gv) = PL_generation;
                        if (gv == PL_defgv || SvCUR(gv) == PL_generation)
                            break;
                        SvCUR(gv) = PL_generation;
@@ -3147,7 +3378,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                lastop = curop;
            }
            if (curop != o)
                lastop = curop;
            }
            if (curop != o)
-               o->op_private = OPpASSIGN_COMMON;
+               o->op_private |= OPpASSIGN_COMMON;
        }
        if (right && right->op_type == OP_SPLIT) {
            OP* tmpop;
        }
        if (right && right->op_type == OP_SPLIT) {
            OP* tmpop;
@@ -3161,7 +3392,13 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                {
                    tmpop = ((UNOP*)left)->op_first;
                    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
                {
                    tmpop = ((UNOP*)left)->op_first;
                    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
-                       pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
+#ifdef USE_ITHREADS
+                       pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+                       cPADOPx(tmpop)->op_padix = 0;   /* steal it */
+#else
+                       pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+                       cSVOPx(tmpop)->op_sv = Nullsv;  /* steal it */
+#endif
                        pm->op_pmflags |= PMf_ONCE;
                        tmpop = cUNOPo->op_first;       /* to list (nulled) */
                        tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
                        pm->op_pmflags |= PMf_ONCE;
                        tmpop = cUNOPo->op_first;       /* to list (nulled) */
                        tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
@@ -3214,7 +3451,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     register COP *cop;
 
     NewOp(1101, cop, 1, COP);
     register COP *cop;
 
     NewOp(1101, cop, 1, COP);
-    if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
+    if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
        cop->op_type = OP_DBSTATE;
        cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
     }
        cop->op_type = OP_DBSTATE;
        cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
     }
@@ -3223,7 +3460,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = flags;
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = flags;
-    cop->op_private = (PL_hints & HINT_UTF8);
+    cop->op_private = (PL_hints & HINT_BYTE);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -3243,20 +3480,23 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 
 
     if (PL_copline == NOLINE)
 
 
     if (PL_copline == NOLINE)
-        cop->cop_line = PL_curcop->cop_line;
+        CopLINE_set(cop, CopLINE(PL_curcop));
     else {
     else {
-        cop->cop_line = PL_copline;
+       CopLINE_set(cop, PL_copline);
         PL_copline = NOLINE;
     }
         PL_copline = NOLINE;
     }
-    cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
-    cop->cop_stash = PL_curstash;
+#ifdef USE_ITHREADS
+    CopFILE_set(cop, CopFILE(PL_curcop));      /* XXXXX share in a pvtable? */
+#else
+    CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
+#endif
+    CopSTASH_set(cop, PL_curstash);
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
-       SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+       SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
        if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
            (void)SvIOK_on(*svp);
        if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
            (void)SvIOK_on(*svp);
-           SvIVX(*svp) = 1;
-           SvSTASH(*svp) = (HV*)cop;
+           SvIVX(*svp) = PTR2IV(cop);
        }
     }
 
        }
     }
 
@@ -3321,9 +3561,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        }
     }
     if (first->op_type == OP_CONST) {
        }
     }
     if (first->op_type == OP_CONST) {
-       if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE))
-           Perl_warner(aTHX_ WARN_PRECEDENCE, "Probable precedence problem on %s", 
-                       PL_op_desc[type]);
+       if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
+           Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional"); 
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
@@ -3341,7 +3580,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        else
            scalar(other);
     }
        else
            scalar(other);
     }
-    else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
+    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
        OPCODE warnop = 0;
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
        OPCODE warnop = 0;
@@ -3368,14 +3607,14 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            break;
        }
        if (warnop) {
            break;
        }
        if (warnop) {
-           line_t oldline = PL_curcop->cop_line;
-           PL_curcop->cop_line = PL_copline;
-           Perl_warner(aTHX_ WARN_UNSAFE,
+           line_t oldline = CopLINE(PL_curcop);
+           CopLINE_set(PL_curcop, PL_copline);
+           Perl_warner(aTHX_ WARN_MISC,
                 "Value of %s%s can be \"0\"; test with defined()",
                 PL_op_desc[warnop],
                 ((warnop == OP_READLINE || warnop == OP_GLOB)
                  ? " construct" : "() operator"));
                 "Value of %s%s can be \"0\"; test with defined()",
                 PL_op_desc[warnop],
                 ((warnop == OP_READLINE || warnop == OP_GLOB)
                  ? " construct" : "() operator"));
-           PL_curcop->cop_line = oldline;
+           CopLINE_set(PL_curcop, oldline);
        }
     }
 
        }
     }
 
@@ -3571,6 +3810,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     OP *listop;
     OP *o;
     OP *condop;
     OP *listop;
     OP *o;
     OP *condop;
+    U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
@@ -3599,11 +3839,19 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     if (!block)
        block = newOP(OP_NULL, 0);
 
     if (!block)
        block = newOP(OP_NULL, 0);
+    else if (cont) {
+       block = scope(block);
+    }
 
 
-    if (cont)
+    if (cont) {
        next = LINKLIST(cont);
        next = LINKLIST(cont);
+       loopflags |= OPpLOOP_CONTINUE;
+    }
     if (expr) {
     if (expr) {
-       cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+       OP *unstack = newOP(OP_UNSTACK, 0);
+       if (!next)
+           next = unstack;
+       cont = append_elem(OP_LINESEQ, cont, unstack);
        if ((line_t)whileline != NOLINE) {
            PL_copline = whileline;
            cont = append_elem(OP_LINESEQ, cont,
        if ((line_t)whileline != NOLINE) {
            PL_copline = whileline;
            cont = append_elem(OP_LINESEQ, cont,
@@ -3626,8 +3874,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        if (listop)
            ((LISTOP*)listop)->op_last->op_next = condop =
                (o == listop ? redo : LINKLIST(o));
        if (listop)
            ((LISTOP*)listop)->op_last->op_next = condop =
                (o == listop ? redo : LINKLIST(o));
-       if (!next)
-           next = condop;
     }
     else
        o = listop;
     }
     else
        o = listop;
@@ -3644,6 +3890,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     loop->op_redoop = redo;
     loop->op_lastop = o;
 
     loop->op_redoop = redo;
     loop->op_lastop = o;
+    o->op_private |= loopflags;
 
     if (next)
        loop->op_nextop = next;
 
     if (next)
        loop->op_nextop = next;
@@ -3659,7 +3906,6 @@ OP *
 Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
 {
     LOOP *loop;
 Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
 {
     LOOP *loop;
-    LOOP *tmp;
     OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
     OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
@@ -3671,11 +3917,13 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
        }
        else if (sv->op_type == OP_PADSV) { /* private variable */
            padoff = sv->op_targ;
        }
        else if (sv->op_type == OP_PADSV) { /* private variable */
            padoff = sv->op_targ;
+           sv->op_targ = 0;
            op_free(sv);
            sv = Nullop;
        }
        else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
            padoff = sv->op_targ;
            op_free(sv);
            sv = Nullop;
        }
        else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
            padoff = sv->op_targ;
+           sv->op_targ = 0;
            iterflags |= OPf_SPECIAL;
            op_free(sv);
            sv = Nullop;
            iterflags |= OPf_SPECIAL;
            op_free(sv);
            sv = Nullop;
@@ -3732,9 +3980,12 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
                               append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
 #ifdef PL_OP_SLAB_ALLOC
                               append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
 #ifdef PL_OP_SLAB_ALLOC
-    NewOp(1234,tmp,1,LOOP);
-    Copy(loop,tmp,1,LOOP);
-    loop = tmp;
+    {
+       LOOP *tmp;
+       NewOp(1234,tmp,1,LOOP);
+       Copy(loop,tmp,1,LOOP);
+       loop = tmp;
+    }
 #else
     Renew(loop, 1, LOOP);
 #endif 
 #else
     Renew(loop, 1, LOOP);
 #endif 
@@ -3793,7 +4044,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif /* USE_THREADS */
        ENTER;
 
 #endif /* USE_THREADS */
        ENTER;
 
-       SAVESPTR(PL_curpad);
+       SAVEVPTR(PL_curpad);
        PL_curpad = 0;
 
        if (!CvCLONED(cv))
        PL_curpad = 0;
 
        if (!CvCLONED(cv))
@@ -3830,10 +4081,10 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 }
 
     }
 }
 
-#ifdef DEBUG_CLOSURES
 STATIC void
 STATIC void
-cv_dump(CV *cv)
+S_cv_dump(pTHX_ CV *cv)
 {
 {
+#ifdef DEBUGGING
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
     AV* pad_name;
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
     AV* pad_name;
@@ -3842,13 +4093,14 @@ cv_dump(CV *cv)
     SV** ppad;
     I32 ix;
 
     SV** ppad;
     I32 ix;
 
-    PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
-                 cv,
+    PerlIO_printf(Perl_debug_log,
+                 "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
+                 PTR2UV(cv),
                  (CvANON(cv) ? "ANON"
                   : (cv == PL_main_cv) ? "MAIN"
                   : CvUNIQUE(cv) ? "UNIQUE"
                   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
                  (CvANON(cv) ? "ANON"
                   : (cv == PL_main_cv) ? "MAIN"
                   : CvUNIQUE(cv) ? "UNIQUE"
                   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
-                 outside,
+                 PTR2UV(outside),
                  (!outside ? "null"
                   : CvANON(outside) ? "ANON"
                   : (outside == PL_main_cv) ? "MAIN"
                  (!outside ? "null"
                   : CvANON(outside) ? "ANON"
                   : (outside == PL_main_cv) ? "MAIN"
@@ -3865,15 +4117,16 @@ cv_dump(CV *cv)
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
-           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
-                         ix, ppad[ix],
+           PerlIO_printf(Perl_debug_log,
+                         "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
+                         (int)ix, PTR2UV(ppad[ix]),
                          SvFAKE(pname[ix]) ? "FAKE " : "",
                          SvPVX(pname[ix]),
                          SvFAKE(pname[ix]) ? "FAKE " : "",
                          SvPVX(pname[ix]),
-                         (long)I_32(SvNVX(pname[ix])),
-                         (long)SvIVX(pname[ix]));
+                         (IV)I_32(SvNVX(pname[ix])),
+                         SvIVX(pname[ix]));
     }
     }
+#endif /* DEBUGGING */
 }
 }
-#endif /* DEBUG_CLOSURES */
 
 STATIC CV *
 S_cv_clone2(pTHX_ CV *proto, CV *outside)
 
 STATIC CV *
 S_cv_clone2(pTHX_ CV *proto, CV *outside)
@@ -3894,23 +4147,21 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     assert(!CvUNIQUE(proto));
 
     ENTER;
     assert(!CvUNIQUE(proto));
 
     ENTER;
-    SAVESPTR(PL_curpad);
-    SAVESPTR(PL_comppad);
+    SAVECOMPPAD();
     SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
 
     cv = PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)cv, SvTYPE(proto));
     SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
 
     cv = PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)cv, SvTYPE(proto));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
     CvCLONED_on(cv);
     CvCLONED_on(cv);
-    if (CvANON(proto))
-       CvANON_on(cv);
 
 #ifdef USE_THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
 
 #ifdef USE_THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
-    CvFILEGV(cv)       = CvFILEGV(proto);
+    CvFILE(cv)         = CvFILE(proto);
     CvGV(cv)           = (GV*)SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = CvROOT(proto);
     CvGV(cv)           = (GV*)SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = CvROOT(proto);
@@ -3969,6 +4220,9 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
                PL_curpad[ix] = sv;
            }
        }
                PL_curpad[ix] = sv;
            }
        }
+       else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+           PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+       }
        else {
            SV* sv = NEWSV(0,0);
            SvPADTMP_on(sv);
        else {
            SV* sv = NEWSV(0,0);
            SvPADTMP_on(sv);
@@ -4011,9 +4265,9 @@ CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
     CV *cv;
 Perl_cv_clone(pTHX_ CV *proto)
 {
     CV *cv;
-    MUTEX_LOCK(&PL_cred_mutex);                /* XXX create separate mutex */
+    LOCK_CRED_MUTEX;                   /* XXX create separate mutex */
     cv = cv_clone2(proto, CvOUTSIDE(proto));
     cv = cv_clone2(proto, CvOUTSIDE(proto));
-    MUTEX_UNLOCK(&PL_cred_mutex);      /* XXX create separate mutex */
+    UNLOCK_CRED_MUTEX;                 /* XXX create separate mutex */
     return cv;
 }
 
     return cv;
 }
 
@@ -4022,7 +4276,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
     dTHR;
 
 {
     dTHR;
 
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
@@ -4030,7 +4284,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            gv_efullname3(name = sv_newmortal(), gv, Nullch);
        sv_setpv(msg, "Prototype mismatch:");
        if (name)
            gv_efullname3(name = sv_newmortal(), gv, Nullch);
        sv_setpv(msg, "Prototype mismatch:");
        if (name)
-           Perl_sv_catpvf(aTHX_ msg, " sub %_", name);
+           Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
            Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
        sv_catpv(msg, " vs ");
        if (SvPOK(cv))
            Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
        sv_catpv(msg, " vs ");
@@ -4038,7 +4292,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
-       Perl_warner(aTHX_ WARN_UNSAFE, "%_", msg);
+       Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
     }
 }
 
     }
 }
 
@@ -4055,10 +4309,10 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
     SV *sv = Nullsv;
 
 {
     SV *sv = Nullsv;
 
-    if(!o)
+    if (!o)
        return Nullsv;
  
        return Nullsv;
  
-    if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
+    if (o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
        o = cLISTOPo->op_first->op_sibling;
 
     for (; o; o = o->op_next) {
        o = cLISTOPo->op_first->op_sibling;
 
     for (; o; o = o->op_next) {
@@ -4072,9 +4326,9 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
            break;
        if (sv)
            return Nullsv;
            break;
        if (sv)
            return Nullsv;
-       if (type == OP_CONST)
+       if (type == OP_CONST && cSVOPo->op_sv)
            sv = cSVOPo->op_sv;
            sv = cSVOPo->op_sv;
-       else if (type == OP_PADSV && cv) {
+       else if ((type == OP_PADSV || type == OP_CONST) && cv) {
            AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
            sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
            if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
            AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
            sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
            if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
@@ -4113,14 +4367,26 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dTHR;
     STRLEN n_a;
 {
     dTHR;
     STRLEN n_a;
-    char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
-    GV *gv = gv_fetchpv(name ? name : "__ANON__",
-                       GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
-                       SVt_PVCV);
+    char *name;
+    char *aname;
+    GV *gv;
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
+    name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+    if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
+       SV *sv = sv_newmortal();
+       Perl_sv_setpvf(aTHX_ sv, "__ANON__[%s:%"IVdf"]",
+                      CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+       aname = SvPVX(sv);
+    }
+    else
+       aname = Nullch;
+    gv = gv_fetchpv(name ? name : (aname ? aname : "__ANON__"),
+                   GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
+                   SVt_PVCV);
+
     if (o)
        SAVEFREEOP(o);
     if (proto)
     if (o)
        SAVEFREEOP(o);
     if (proto)
@@ -4132,9 +4398,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
            if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
            if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
-               && ckWARN_d(WARN_UNSAFE))
+               && ckWARN_d(WARN_PROTOTYPE))
            {
            {
-               Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+               Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
            }
            cv_ckproto((CV*)gv, NULL, ps);
        }
            }
            cv_ckproto((CV*)gv, NULL, ps);
        }
@@ -4150,7 +4416,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     if (!name || GvCVGEN(gv))
        cv = Nullcv;
 
     if (!name || GvCVGEN(gv))
        cv = Nullcv;
-    else if (cv = GvCV(gv)) {
+    else if ((cv = GvCV(gv))) {
        cv_ckproto(cv, gv, ps);
        /* already defined (or promised)? */
        if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
        cv_ckproto(cv, gv, ps);
        /* already defined (or promised)? */
        if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
@@ -4166,19 +4432,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
            if (!block)
                goto withattrs;
                Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
            if (!block)
                goto withattrs;
-           if(const_sv = cv_const_sv(cv))
+           if ((const_sv = cv_const_sv(cv)))
                const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
                const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
-           if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE) 
-                                       && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                                       && HvNAME(GvSTASH(CvGV(cv)))
-                                       && strEQ(HvNAME(GvSTASH(CvGV(cv))),
-                                                "autouse"))) {
-               line_t oldline = PL_curcop->cop_line;
-               PL_curcop->cop_line = PL_copline;
+           if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
+           {
+               line_t oldline = CopLINE(PL_curcop);
+               CopLINE_set(PL_curcop, PL_copline);
                Perl_warner(aTHX_ WARN_REDEFINE,
                        const_sv ? "Constant subroutine %s redefined"
                                 : "Subroutine %s redefined", name);
                Perl_warner(aTHX_ WARN_REDEFINE,
                        const_sv ? "Constant subroutine %s redefined"
                                 : "Subroutine %s redefined", name);
-               PL_curcop->cop_line = oldline;
+               CopLINE_set(PL_curcop, oldline);
            }
            SvREFCNT_dec(cv);
            cv = Nullcv;
            }
            SvREFCNT_dec(cv);
            cv = Nullcv;
@@ -4236,7 +4499,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
        }
     }
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
-    CvFILEGV(cv) = PL_curcop->cop_filegv;
+    CvFILE(cv) = CopFILE(PL_curcop);
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
@@ -4278,12 +4541,25 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
        av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
        av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
+    if (CvLVALUE(cv)) {
+       CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
+    }
+    else {
+       CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+    }
+    CvROOT(cv)->op_private |= OPpREFCOUNTED;
+    OpREFCNT_set(CvROOT(cv), 1);
+    CvSTART(cv) = LINKLIST(CvROOT(cv));
+    CvROOT(cv)->op_next = 0;
+    peep(CvSTART(cv));
+
+    /* now that optimizer has done its work, adjust pad values */
     if (CvCLONE(cv)) {
        SV **namep = AvARRAY(PL_comppad_name);
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            SV *namesv;
 
     if (CvCLONE(cv)) {
        SV **namep = AvARRAY(PL_comppad_name);
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            SV *namesv;
 
-           if (SvIMMORTAL(PL_curpad[ix]))
+           if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
                continue;
            /*
             * The only things that a clonable function needs in its
                continue;
            /*
             * The only things that a clonable function needs in its
@@ -4307,65 +4583,61 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        AvFLAGS(av) = AVf_REIFY;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        AvFLAGS(av) = AVf_REIFY;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-           if (SvIMMORTAL(PL_curpad[ix]))
+           if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
                continue;
            if (!SvPADMY(PL_curpad[ix]))
                SvPADTMP_on(PL_curpad[ix]);
        }
     }
 
                continue;
            if (!SvPADMY(PL_curpad[ix]))
                SvPADTMP_on(PL_curpad[ix]);
        }
     }
 
-    if(CvLVALUE(cv)) {
-       CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
-    }
-    else {
-       CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
-    }
-    CvSTART(cv) = LINKLIST(CvROOT(cv));
-    CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
-
-    if (name) {
+    if (name || aname) {
        char *s;
        char *s;
+       char *tname = (name ? name : aname);
 
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV *sv = NEWSV(0,0);
            SV *tmpstr = sv_newmortal();
            GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
 
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV *sv = NEWSV(0,0);
            SV *tmpstr = sv_newmortal();
            GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
-           CV *cv;
+           CV *pcv;
            HV *hv;
 
            HV *hv;
 
-           Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-                   GvSV(PL_curcop->cop_filegv),
-                   (long)PL_subline, (long)PL_curcop->cop_line);
+           Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+                          CopFILE(PL_curcop),
+                          (long)PL_subline, (long)CopLINE(PL_curcop));
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
            hv = GvHVn(db_postponed);
            if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
            hv = GvHVn(db_postponed);
            if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
-                 && (cv = GvCV(db_postponed))) {
+               && (pcv = GvCV(db_postponed)))
+           {
                dSP;
                PUSHMARK(SP);
                XPUSHs(tmpstr);
                PUTBACK;
                dSP;
                PUSHMARK(SP);
                XPUSHs(tmpstr);
                PUTBACK;
-               call_sv((SV*)cv, G_DISCARD);
+               call_sv((SV*)pcv, G_DISCARD);
            }
        }
 
            }
        }
 
-       if ((s = strrchr(name,':')))
+       if ((s = strrchr(tname,':')))
            s++;
        else
            s++;
        else
-           s = name;
+           s = tname;
+
+       if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
        if (strEQ(s, "BEGIN")) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
-           SAVESPTR(PL_compiling.cop_filegv);
-           SAVEI16(PL_compiling.cop_line);
+           SAVECOPFILE(&PL_compiling);
+           SAVECOPLINE(&PL_compiling);
            save_svref(&PL_rs);
            sv_setsv(PL_rs, PL_nrs);
 
            if (!PL_beginav)
                PL_beginav = newAV();
            DEBUG_x( dump_sub(gv) );
            save_svref(&PL_rs);
            sv_setsv(PL_rs, PL_nrs);
 
            if (!PL_beginav)
                PL_beginav = newAV();
            DEBUG_x( dump_sub(gv) );
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
            call_list(oldscope, PL_beginav);
 
            GvCV(gv) = 0;
            call_list(oldscope, PL_beginav);
 
@@ -4376,13 +4648,27 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else if (strEQ(s, "END") && !PL_error_count) {
            if (!PL_endav)
                PL_endav = newAV();
        else if (strEQ(s, "END") && !PL_error_count) {
            if (!PL_endav)
                PL_endav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_unshift(PL_endav, 1);
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
+           GvCV(gv) = 0;
+       }
+       else if (strEQ(s, "CHECK") && !PL_error_count) {
+           if (!PL_checkav)
+               PL_checkav = newAV();
+           DEBUG_x( dump_sub(gv) );
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+           av_unshift(PL_checkav, 1);
+           av_store(PL_checkav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT") && !PL_error_count) {
            if (!PL_initav)
                PL_initav = newAV();
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT") && !PL_error_count) {
            if (!PL_initav)
                PL_initav = newAV();
+           DEBUG_x( dump_sub(gv) );
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
@@ -4395,19 +4681,37 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 }
 
 /* XXX unsafe for threads if eval_owner isn't held */
 }
 
 /* XXX unsafe for threads if eval_owner isn't held */
+/*
+=for apidoc newCONSTSUB
+
+Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
+eligible for inlining at compile-time.
+
+=cut
+*/
+
 void
 Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 {
     dTHR;
 void
 Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 {
     dTHR;
-    U32 oldhints = PL_hints;
-    HV *old_cop_stash = PL_curcop->cop_stash;
-    HV *old_curstash = PL_curstash;
-    line_t oldline = PL_curcop->cop_line;
-    PL_curcop->cop_line = PL_copline;
 
 
+    ENTER;
+    SAVECOPLINE(PL_curcop);
+    SAVEHINTS();
+
+    CopLINE_set(PL_curcop, PL_copline);
     PL_hints &= ~HINT_BLOCK_SCOPE;
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    if(stash)
-       PL_curstash = PL_curcop->cop_stash = stash;
+
+    if (stash) {
+       SAVESPTR(PL_curstash);
+       SAVECOPSTASH(PL_curcop);
+       PL_curstash = stash;
+#ifdef USE_ITHREADS
+       CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
+#else
+       CopSTASH(PL_curcop) = stash;
+#endif
+    }
 
     newATTRSUB(
        start_subparse(FALSE, 0),
 
     newATTRSUB(
        start_subparse(FALSE, 0),
@@ -4417,12 +4721,17 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
        newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
     );
 
        newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
     );
 
-    PL_hints = oldhints;
-    PL_curcop->cop_stash = old_cop_stash;
-    PL_curstash = old_curstash;
-    PL_curcop->cop_line = oldline;
+    LEAVE;
 }
 
 }
 
+/*
+=for apidoc U||newXS
+
+Used by C<xsubpp> to hook up XSUBs as Perl subs.
+
+=cut
+*/
+
 CV *
 Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 {
 CV *
 Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 {
@@ -4430,7 +4739,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
 
-    if (cv = (name ? GvCV(gv) : Nullcv)) {
+    if ((cv = (name ? GvCV(gv) : Nullcv))) {
        if (GvCVGEN(gv)) {
            /* just a cached method */
            SvREFCNT_dec(cv);
        if (GvCVGEN(gv)) {
            /* just a cached method */
            SvREFCNT_dec(cv);
@@ -4441,11 +4750,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
            if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
                            && HvNAME(GvSTASH(CvGV(cv)))
                            && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
            if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
                            && HvNAME(GvSTASH(CvGV(cv)))
                            && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
-               line_t oldline = PL_curcop->cop_line;
+               line_t oldline = CopLINE(PL_curcop);
                if (PL_copline != NOLINE)
                if (PL_copline != NOLINE)
-                   PL_curcop->cop_line = PL_copline;
+                   CopLINE_set(PL_curcop, PL_copline);
                Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
                Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
-               PL_curcop->cop_line = oldline;
+               CopLINE_set(PL_curcop, oldline);
            }
            SvREFCNT_dec(cv);
            cv = 0;
            }
            SvREFCNT_dec(cv);
            cv = 0;
@@ -4469,7 +4778,9 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv) = 0;
 #endif /* USE_THREADS */
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv) = 0;
 #endif /* USE_THREADS */
-    CvFILEGV(cv) = gv_fetchfile(filename);
+    (void)gv_fetchfile(filename);
+    CvFILE(cv) = filename;     /* NOTE: not copied, as it is expected to be
+                                  an external constant string */
     CvXSUB(cv) = subaddr;
 
     if (name) {
     CvXSUB(cv) = subaddr;
 
     if (name) {
@@ -4478,29 +4789,45 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
            s++;
        else
            s = name;
            s++;
        else
            s = name;
+
+       if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            if (!PL_beginav)
                PL_beginav = newAV();
        if (strEQ(s, "BEGIN")) {
            if (!PL_beginav)
                PL_beginav = newAV();
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "END")) {
            if (!PL_endav)
                PL_endav = newAV();
            av_unshift(PL_endav, 1);
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "END")) {
            if (!PL_endav)
                PL_endav = newAV();
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
+           GvCV(gv) = 0;
+       }
+       else if (strEQ(s, "CHECK")) {
+           if (!PL_checkav)
+               PL_checkav = newAV();
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
+           av_unshift(PL_checkav, 1);
+           av_store(PL_checkav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT")) {
            if (!PL_initav)
                PL_initav = newAV();
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT")) {
            if (!PL_initav)
                PL_initav = newAV();
-           av_push(PL_initav, (SV *)cv);
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
+           av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
     }
     else
        CvANON_on(cv);
 
            GvCV(gv) = 0;
        }
     }
     else
        CvANON_on(cv);
 
+done:
     return cv;
 }
 
     return cv;
 }
 
@@ -4520,20 +4847,20 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
     GvMULTI_on(gv);
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
     GvMULTI_on(gv);
-    if (cv = GvFORM(gv)) {
+    if ((cv = GvFORM(gv))) {
        if (ckWARN(WARN_REDEFINE)) {
        if (ckWARN(WARN_REDEFINE)) {
-           line_t oldline = PL_curcop->cop_line;
+           line_t oldline = CopLINE(PL_curcop);
 
 
-           PL_curcop->cop_line = PL_copline;
+           CopLINE_set(PL_curcop, PL_copline);
            Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
            Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
-           PL_curcop->cop_line = oldline;
+           CopLINE_set(PL_curcop, oldline);
        }
        SvREFCNT_dec(cv);
     }
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
        }
        SvREFCNT_dec(cv);
     }
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
-    CvFILEGV(cv) = PL_curcop->cop_filegv;
+    CvFILE(cv) = CopFILE(PL_curcop);
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -4541,6 +4868,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     }
 
     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
     }
 
     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
+    CvROOT(cv)->op_private |= OPpREFCOUNTED;
+    OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
@@ -4755,11 +5084,22 @@ Perl_ck_delete(pTHX_ OP *o)
     o->op_private = 0;
     if (o->op_flags & OPf_KIDS) {
        OP *kid = cUNOPo->op_first;
     o->op_private = 0;
     if (o->op_flags & OPf_KIDS) {
        OP *kid = cUNOPo->op_first;
-       if (kid->op_type == OP_HSLICE)
+       switch (kid->op_type) {
+       case OP_ASLICE:
+           o->op_flags |= OPf_SPECIAL;
+           /* FALL THROUGH */
+       case OP_HSLICE:
            o->op_private |= OPpSLICE;
            o->op_private |= OPpSLICE;
-       else if (kid->op_type != OP_HELEM)
-           Perl_croak(aTHX_ "%s argument is not a HASH element or slice",
+           break;
+       case OP_AELEM:
+           o->op_flags |= OPf_SPECIAL;
+           /* FALL THROUGH */
+       case OP_HELEM:
+           break;
+       default:
+           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
                  PL_op_desc[o->op_type]);
                  PL_op_desc[o->op_type]);
+       }
        null(kid);
     }
     return o;
        null(kid);
     }
     return o;
@@ -4825,6 +5165,20 @@ Perl_ck_eval(pTHX_ OP *o)
 }
 
 OP *
 }
 
 OP *
+Perl_ck_exit(pTHX_ OP *o)
+{
+#ifdef VMS
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+       SV **svp = hv_fetch(table, "vmsish_exit", 11, FALSE);
+       if (svp && *svp && SvTRUE(*svp))
+           o->op_private |= OPpEXIT_VMSISH;
+    }
+#endif
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_exec(pTHX_ OP *o)
 {
     OP *kid;
 Perl_ck_exec(pTHX_ OP *o)
 {
     OP *kid;
@@ -4845,8 +5199,18 @@ Perl_ck_exists(pTHX_ OP *o)
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
        OP *kid = cUNOPo->op_first;
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
        OP *kid = cUNOPo->op_first;
-       if (kid->op_type != OP_HELEM)
-           Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]);
+       if (kid->op_type == OP_ENTERSUB) {
+           (void) ref(kid, o->op_type);
+           if (kid->op_type != OP_RV2CV && !PL_error_count)
+               Perl_croak(aTHX_ "%s argument is not a subroutine name",
+                          PL_op_desc[o->op_type]);
+           o->op_private |= OPpEXISTS_SUB;
+       }
+       else if (kid->op_type == OP_AELEM)
+           o->op_flags |= OPf_SPECIAL;
+       else if (kid->op_type != OP_HELEM)
+           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+                      PL_op_desc[o->op_type]);
        null(kid);
     }
     return o;
        null(kid);
     }
     return o;
@@ -4958,7 +5322,14 @@ Perl_ck_rvconst(pTHX_ register OP *o)
        if (gv) {
            kid->op_type = OP_GV;
            SvREFCNT_dec(kid->op_sv);
        if (gv) {
            kid->op_type = OP_GV;
            SvREFCNT_dec(kid->op_sv);
+#ifdef USE_ITHREADS
+           /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+           kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
+           GvIN_PAD_on(gv);
+           PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
+#else
            kid->op_sv = SvREFCNT_inc(gv);
            kid->op_sv = SvREFCNT_inc(gv);
+#endif
            kid->op_ppaddr = PL_ppaddr[OP_GV];
        }
     }
            kid->op_ppaddr = PL_ppaddr[OP_GV];
        }
     }
@@ -4971,10 +5342,10 @@ Perl_ck_ftst(pTHX_ OP *o)
     dTHR;
     I32 type = o->op_type;
 
     dTHR;
     I32 type = o->op_type;
 
-    if (o->op_flags & OPf_REF)
-       return o;
-
-    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+    if (o->op_flags & OPf_REF) {
+       /* nothing */
+    }
+    else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
@@ -4982,17 +5353,24 @@ Perl_ck_ftst(pTHX_ OP *o)
            OP *newop = newGVOP(type, OPf_REF,
                gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
            op_free(o);
            OP *newop = newGVOP(type, OPf_REF,
                gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
            op_free(o);
-           return newop;
+           o = newop;
        }
     }
     else {
        op_free(o);
        if (type == OP_FTTTY)
        }
     }
     else {
        op_free(o);
        if (type == OP_FTTTY)
-           return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
                                SVt_PVIO));
        else
                                SVt_PVIO));
        else
-           return newUNOP(type, 0, newDEFSVOP());
+           o = newUNOP(type, 0, newDEFSVOP());
     }
     }
+#ifdef USE_LOCALE
+    if (type == OP_FTTEXT || type == OP_FTBINARY) {
+       o->op_private = 0;
+       if (PL_hints & HINT_LOCALE)
+           o->op_private |= OPpLOCALE;
+    }
+#endif
     return o;
 }
 
     return o;
 }
 
@@ -5019,7 +5397,7 @@ Perl_ck_fun(pTHX_ OP *o)
        tokid = &cLISTOPo->op_first;
        kid = cLISTOPo->op_first;
        if (kid->op_type == OP_PUSHMARK ||
        tokid = &cLISTOPo->op_first;
        kid = cLISTOPo->op_first;
        if (kid->op_type == OP_PUSHMARK ||
-           kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
+           (kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK))
        {
            tokid = &kid->op_sibling;
            kid = kid->op_sibling;
        {
            tokid = &kid->op_sibling;
            kid = kid->op_sibling;
@@ -5055,8 +5433,8 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
+                   if (ckWARN(WARN_DEPRECATED))
+                       Perl_warner(aTHX_ WARN_DEPRECATED,
                            "Array @%s missing the @ in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
                            "Array @%s missing the @ in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
@@ -5075,8 +5453,8 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
+                   if (ckWARN(WARN_DEPRECATED))
+                       Perl_warner(aTHX_ WARN_DEPRECATED,
                            "Hash %%%s missing the %% in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
                            "Hash %%%s missing the %% in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
@@ -5117,26 +5495,53 @@ Perl_ck_fun(pTHX_ OP *o)
                    else {
                        I32 flags = OPf_SPECIAL;
                        I32 priv = 0;
                    else {
                        I32 flags = OPf_SPECIAL;
                        I32 priv = 0;
+                       PADOFFSET targ = 0;
+
                        /* is this op a FH constructor? */
                        if (is_handle_constructor(o,numargs)) {
                        /* is this op a FH constructor? */
                        if (is_handle_constructor(o,numargs)) {
-                           flags   = 0;                         
-                           /* Set a flag to tell rv2gv to vivify 
+                           char *name = Nullch;
+                           STRLEN len;
+
+                           flags = 0;
+                           /* Set a flag to tell rv2gv to vivify
                             * need to "prove" flag does not mean something
                             * else already - NI-S 1999/05/07
                             * need to "prove" flag does not mean something
                             * else already - NI-S 1999/05/07
-                            */ 
-                           priv = OPpDEREF; 
-#if 0
-                           /* Helps with open($array[$n],...) 
-                              but is too simplistic - need to do selectively
-                           */
-                           mod(kid,type);
-#endif
+                            */
+                           priv = OPpDEREF;
+                           if (kid->op_type == OP_PADSV) {
+                               SV **namep = av_fetch(PL_comppad_name,
+                                                     kid->op_targ, 4);
+                               if (namep && *namep)
+                                   name = SvPV(*namep, len);
+                           }
+                           else if (kid->op_type == OP_RV2SV
+                                    && kUNOP->op_first->op_type == OP_GV)
+                           {
+                               GV *gv = cGVOPx_gv(kUNOP->op_first);
+                               name = GvNAME(gv);
+                               len = GvNAMELEN(gv);
+                           }
+                           else if (kid->op_type == OP_AELEM
+                                    || kid->op_type == OP_HELEM)
+                           {
+                               name = "__ANONIO__";
+                               len = 10;
+                               mod(kid,type);
+                           }
+                           if (name) {
+                               SV *namesv;
+                               targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+                               namesv = PL_curpad[targ];
+                               (void)SvUPGRADE(namesv, SVt_PV);
+                               if (*name != '$')
+                                   sv_setpvn(namesv, "$", 1);
+                               sv_catpvn(namesv, name, len);
+                           }
                        }
                        kid->op_sibling = 0;
                        kid = newUNOP(OP_RV2GV, flags, scalar(kid));
                        }
                        kid->op_sibling = 0;
                        kid = newUNOP(OP_RV2GV, flags, scalar(kid));
-                       if (priv) {
-                           kid->op_private |= priv;
-                       }
+                       kid->op_targ = targ;
+                       kid->op_private |= priv;
                    }
                    kid->op_sibling = sibl;
                    *tokid = kid;
                    }
                    kid->op_sibling = sibl;
                    *tokid = kid;
@@ -5175,24 +5580,24 @@ Perl_ck_glob(pTHX_ OP *o)
 {
     GV *gv;
 
 {
     GV *gv;
 
+    o = ck_fun(o);
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        append_elem(OP_GLOB, o, newDEFSVOP());
 
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        append_elem(OP_GLOB, o, newDEFSVOP());
 
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
-#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+#if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
-       OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
-       modname->op_private |= OPpCONST_BARE;
        ENTER;
        ENTER;
-       utilize(1, start_subparse(FALSE, 0), Nullop, modname,
-               newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+       Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv,
+                        /* null-terminated import list */
+                        newSVpvn(":globally", 9), Nullsv);
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
        LEAVE;
     }
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
        LEAVE;
     }
-#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+#endif /* PERL_EXTERNAL_GLOB */
 
     if (gv && GvIMPORTED_CV(gv)) {
        append_elem(OP_GLOB, o,
 
     if (gv && GvIMPORTED_CV(gv)) {
        append_elem(OP_GLOB, o,
@@ -5213,7 +5618,7 @@ Perl_ck_glob(pTHX_ OP *o)
     gv_IOadd(gv);
     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
     gv_IOadd(gv);
     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
-    return ck_fun(o);
+    return o;
 }
 
 OP *
 }
 
 OP *
@@ -5307,15 +5712,15 @@ Perl_ck_defined(pTHX_ OP *o)            /* 19990527 MJD */
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(@array) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(@array) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
        break;
        case OP_RV2HV:
            break;                      /* Globals via GV can be undef */ 
        case OP_PADHV:
            Perl_warner(aTHX_ WARN_DEPRECATED,
        break;
        case OP_RV2HV:
            break;                      /* Globals via GV can be undef */ 
        case OP_PADHV:
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "defined(%hash) is deprecated");
+                       "defined(%%hash) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
            break;
        default:
            /* no warning */
            break;
        default:
            /* no warning */
@@ -5390,7 +5795,9 @@ Perl_ck_sassign(pTHX_ OP *o)
     OP *kid = cLISTOPo->op_first;
     /* has a disposable target? */
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
     OP *kid = cLISTOPo->op_first;
     /* has a disposable target? */
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
-       && !(kid->op_flags & OPf_STACKED))
+       && !(kid->op_flags & OPf_STACKED)
+       /* Cannot steal the second time! */
+       && !(kid->op_private & OPpTARGET_MY))
     {
        OP *kkid = kid->op_sibling;
 
     {
        OP *kkid = kid->op_sibling;
 
@@ -5398,32 +5805,8 @@ Perl_ck_sassign(pTHX_ OP *o)
        if (kkid && kkid->op_type == OP_PADSV
            && !(kkid->op_private & OPpLVAL_INTRO))
        {
        if (kkid && kkid->op_type == OP_PADSV
            && !(kkid->op_private & OPpLVAL_INTRO))
        {
-           /* Concat has problems if target is equal to right arg. */
-           if (kid->op_type == OP_CONCAT) {
-               if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV
-                   && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
-                   return o;
-           }
-           else if (kid->op_type == OP_JOIN) {
-               /* do_join has problems if the arguments coincide with target.
-                  In fact the second argument *can* safely coincide,
-                  but ignore=pessimize this rare occasion. */
-               OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
-
-               while (arg) {
-                   if (arg->op_type == OP_PADSV
-                       && arg->op_targ == kkid->op_targ)
-                       return o;
-                   arg = arg->op_sibling;
-               }
-           }
-           else if (kid->op_type == OP_QUOTEMETA) {
-               /* quotemeta has problems if the argument coincides with target. */
-               if (kLISTOP->op_first->op_type == OP_PADSV
-                   && kLISTOP->op_first->op_targ == kkid->op_targ)
-                   return o;
-           }
            kid->op_targ = kkid->op_targ;
            kid->op_targ = kkid->op_targ;
+           kkid->op_targ = 0;
            /* Now we do not need PADSV and SASSIGN. */
            kid->op_sibling = o->op_sibling;    /* NULL */
            cLISTOPo->op_first = NULL;
            /* Now we do not need PADSV and SASSIGN. */
            kid->op_sibling = o->op_sibling;    /* NULL */
            cLISTOPo->op_first = NULL;
@@ -5463,8 +5846,8 @@ Perl_ck_method(pTHX_ OP *o)
        SV* sv = kSVOP->op_sv;
        if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
            OP *cmop;
        SV* sv = kSVOP->op_sv;
        if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
            OP *cmop;
-           sv_upgrade(sv, SVt_PVIV);
-           SvIOK_on(sv);
+           (void)SvUPGRADE(sv, SVt_PVIV);
+           (void)SvIOK_on(sv);
            PERL_HASH(SvUVX(sv), SvPVX(sv), SvCUR(sv));
            cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
            kSVOP->op_sv = Nullsv;
            PERL_HASH(SvUVX(sv), SvPVX(sv), SvCUR(sv));
            cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
            kSVOP->op_sv = Nullsv;
@@ -5482,6 +5865,36 @@ Perl_ck_null(pTHX_ OP *o)
 }
 
 OP *
 }
 
 OP *
+Perl_ck_open(pTHX_ OP *o)
+{
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+       SV **svp;
+       I32 mode;
+       svp = hv_fetch(table, "open_IN", 7, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_IN_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_IN_CRLF;
+       }
+
+       svp = hv_fetch(table, "open_OUT", 8, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_OUT_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_OUT_CRLF;
+       }
+    }
+    if (o->op_type == OP_BACKTICK)
+       return o;
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
 Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
@@ -5508,7 +5921,13 @@ Perl_ck_require(pTHX_ OP *o)
                    --SvCUR(kid->op_sv);
                }
            }
                    --SvCUR(kid->op_sv);
                }
            }
-           sv_catpvn(kid->op_sv, ".pm", 3);
+           if (SvREADONLY(kid->op_sv)) {
+               SvREADONLY_off(kid->op_sv);
+               sv_catpvn(kid->op_sv, ".pm", 3);
+               SvREADONLY_on(kid->op_sv);
+           }
+           else
+               sv_catpvn(kid->op_sv, ".pm", 3);
        }
     }
     return ck_fun(o);
        }
     }
     return ck_fun(o);
@@ -5603,6 +6022,12 @@ Perl_ck_sort(pTHX_ OP *o)
                    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
                        if (k->op_next == kid)
                            k->op_next = 0;
                    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
                        if (k->op_next == kid)
                            k->op_next = 0;
+                       /* don't descend into loops */
+                       else if (k->op_type == OP_ENTERLOOP
+                                || k->op_type == OP_ENTERITER)
+                       {
+                           k = cLOOPx(k)->op_lastop;
+                       }
                    }
                }
                else
                    }
                }
                else
@@ -5632,6 +6057,7 @@ S_simplify_sort(pTHX_ OP *o)
     register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
     OP *k;
     int reversed;
     register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
     OP *k;
     int reversed;
+    GV *gv;
     if (!(o->op_flags & OPf_STACKED))
        return;
     GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); 
     if (!(o->op_flags & OPf_STACKED))
        return;
     GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); 
@@ -5655,11 +6081,12 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
-    if (GvSTASH(kGVOP->op_gv) != PL_curstash)
+    gv = kGVOP_gv;
+    if (GvSTASH(gv) != PL_curstash)
        return;
        return;
-    if (strEQ(GvNAME(kGVOP->op_gv), "a"))
+    if (strEQ(GvNAME(gv), "a"))
        reversed = 0;
        reversed = 0;
-    else if(strEQ(GvNAME(kGVOP->op_gv), "b"))
+    else if (strEQ(GvNAME(gv), "b"))
        reversed = 1;
     else
        return;
        reversed = 1;
     else
        return;
@@ -5670,10 +6097,11 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
-    if (GvSTASH(kGVOP->op_gv) != PL_curstash
+    gv = kGVOP_gv;
+    if (GvSTASH(gv) != PL_curstash
        || ( reversed
        || ( reversed
-           ? strNE(GvNAME(kGVOP->op_gv), "a")
-           : strNE(GvNAME(kGVOP->op_gv), "b")))
+           ? strNE(GvNAME(gv), "a")
+           : strNE(GvNAME(gv), "b")))
        return;
     o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
     if (reversed)
        return;
     o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
     if (reversed)
@@ -5779,11 +6207,12 @@ Perl_ck_subr(pTHX_ OP *o)
        null(cvop);             /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
        if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
        null(cvop);             /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
        if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
-           cv = GvCVu(tmpop->op_sv);
+           GV *gv = cGVOPx_gv(tmpop);
+           cv = GvCVu(gv);
            if (!cv)
                tmpop->op_private |= OPpEARLY_CV;
            else if (SvPOK(cv)) {
            if (!cv)
                tmpop->op_private |= OPpEARLY_CV;
            else if (SvPOK(cv)) {
-               namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
+               namegv = CvANON(cv) ? gv : CvGV(cv);
                proto = SvPV((SV*)cv, n_a);
            }
        }
                proto = SvPV((SV*)cv, n_a);
            }
        }
@@ -5846,7 +6275,7 @@ Perl_ck_subr(pTHX_ OP *o)
                                (gvop = ((UNOP*)gvop)->op_first) &&
                                gvop->op_type == OP_GV)
                            {
                                (gvop = ((UNOP*)gvop)->op_first) &&
                                gvop->op_type == OP_GV)
                            {
-                               GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+                               GV *gv = cGVOPx_gv(gvop);
                                OP *sibling = o2->op_sibling;
                                SV *n = newSVpvn("",0);
                                op_free(o2);
                                OP *sibling = o2->op_sibling;
                                SV *n = newSVpvn("",0);
                                op_free(o2);
@@ -5964,7 +6393,7 @@ Perl_peep(pTHX_ register OP *o)
        return;
     ENTER;
     SAVEOP();
        return;
     ENTER;
     SAVEOP();
-    SAVESPTR(PL_curcop);
+    SAVEVPTR(PL_curcop);
     for (; o; o = o->op_next) {
        if (o->op_seq)
            break;
     for (; o; o = o->op_next) {
        if (o->op_seq)
            break;
@@ -5983,32 +6412,31 @@ Perl_peep(pTHX_ register OP *o)
        case OP_CONST:
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
        case OP_CONST:
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
-           /* FALL THROUGH */
-       case OP_UC:
-       case OP_UCFIRST:
-       case OP_LC:
-       case OP_LCFIRST:
-           if ( o->op_next && o->op_next->op_type == OP_STRINGIFY
-                && !(o->op_next->op_private & OPpTARGET_MY) )
-               null(o->op_next);
+#ifdef USE_ITHREADS
+           /* Relocate sv to the pad for thread safety.
+            * Despite being a "constant", the SV is written to,
+            * for reference counts, sv_upgrade() etc. */
+           if (cSVOP->op_sv) {
+               PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+               SvREFCNT_dec(PL_curpad[ix]);
+               SvPADTMP_on(cSVOPo->op_sv);
+               PL_curpad[ix] = cSVOPo->op_sv;
+               cSVOPo->op_sv = Nullsv;
+               o->op_targ = ix;
+           }
+#endif
            o->op_seq = PL_op_seqmax++;
            break;
            o->op_seq = PL_op_seqmax++;
            break;
+
        case OP_CONCAT:
        case OP_CONCAT:
-       case OP_JOIN:
-       case OP_QUOTEMETA:
            if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
                if (o->op_next->op_private & OPpTARGET_MY) {
            if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
                if (o->op_next->op_private & OPpTARGET_MY) {
-                   if ((o->op_flags & OPf_STACKED) /* chained concats */
-                       || (o->op_type == OP_CONCAT
-           /* Concat has problems if target is equal to right arg. */
-                           && (((LISTOP*)o)->op_first->op_sibling->op_type
-                               == OP_PADSV)
-                           && (((LISTOP*)o)->op_first->op_sibling->op_targ
-                               == o->op_next->op_targ))) {
+                   if (o->op_flags & OPf_STACKED) /* chained concats */
                        goto ignore_optimization;
                        goto ignore_optimization;
-                   }
                    else {
                    else {
+                       /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
                        o->op_targ = o->op_next->op_targ;
                        o->op_targ = o->op_next->op_targ;
+                       o->op_next->op_targ = 0;
                        o->op_private |= OPpTARGET_MY;
                    }
                }
                        o->op_private |= OPpTARGET_MY;
                    }
                }
@@ -6046,7 +6474,8 @@ Perl_peep(pTHX_ register OP *o)
            if (o->op_next->op_type == OP_RV2SV) {
                if (!(o->op_next->op_private & OPpDEREF)) {
                    null(o->op_next);
            if (o->op_next->op_type == OP_RV2SV) {
                if (!(o->op_next->op_private & OPpDEREF)) {
                    null(o->op_next);
-                   o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
+                   o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
+                                                              | OPpOUR_INTRO);
                    o->op_next = o->op_next->op_next;
                    o->op_type = OP_GVSV;
                    o->op_ppaddr = PL_ppaddr[OP_GVSV];
                    o->op_next = o->op_next->op_next;
                    o->op_type = OP_GVSV;
                    o->op_ppaddr = PL_ppaddr[OP_GVSV];
@@ -6064,6 +6493,7 @@ Perl_peep(pTHX_ register OP *o)
                                <= 255 &&
                    i >= 0)
                {
                                <= 255 &&
                    i >= 0)
                {
+                   GV *gv;
                    null(o->op_next);
                    null(pop->op_next);
                    null(pop);
                    null(o->op_next);
                    null(pop->op_next);
                    null(pop);
@@ -6072,16 +6502,17 @@ Perl_peep(pTHX_ register OP *o)
                    o->op_type = OP_AELEMFAST;
                    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
                    o->op_private = (U8)i;
                    o->op_type = OP_AELEMFAST;
                    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
                    o->op_private = (U8)i;
-                   GvAVn(((GVOP*)o)->op_gv);
+                   gv = cGVOPo_gv;
+                   GvAVn(gv);
                }
            }
                }
            }
-           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
-               GV *gv = cGVOPo->op_gv;
+           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
+               GV *gv = cGVOPo_gv;
                if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
                    /* XXX could check prototype here instead of just carping */
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
                if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
                    /* XXX could check prototype here instead of just carping */
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_PROTOTYPE,
                                "%s() called too early to check prototype",
                                SvPV_nolen(sv));
                }
                                "%s() called too early to check prototype",
                                SvPV_nolen(sv));
                }
@@ -6126,12 +6557,14 @@ Perl_peep(pTHX_ register OP *o)
                        o->op_next->op_sibling->op_type != OP_EXIT &&
                        o->op_next->op_sibling->op_type != OP_WARN &&
                        o->op_next->op_sibling->op_type != OP_DIE) {
                        o->op_next->op_sibling->op_type != OP_EXIT &&
                        o->op_next->op_sibling->op_type != OP_WARN &&
                        o->op_next->op_sibling->op_type != OP_DIE) {
-                   line_t oldline = PL_curcop->cop_line;
-
-                   PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
-                   Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached");
-                   Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
-                   PL_curcop->cop_line = oldline;
+                   line_t oldline = CopLINE(PL_curcop);
+
+                   CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
+                   Perl_warner(aTHX_ WARN_EXEC,
+                               "Statement unlikely to be reached");
+                   Perl_warner(aTHX_ WARN_EXEC,
+                               "\t(Maybe you meant system() when you said exec()?)\n");
+                   CopLINE_set(PL_curcop, oldline);
                }
            }
            break;
                }
            }
            break;
@@ -6140,11 +6573,12 @@ Perl_peep(pTHX_ register OP *o)
            UNOP *rop;
            SV *lexname;
            GV **fields;
            UNOP *rop;
            SV *lexname;
            GV **fields;
-           SV **svp, **indsvp;
+           SV **svp, **indsvp, *sv;
            I32 ind;
            char *key;
            STRLEN keylen;
        
            I32 ind;
            char *key;
            STRLEN keylen;
        
+           o->op_seq = PL_op_seqmax++;
            if ((o->op_private & (OPpLVAL_INTRO))
                || ((BINOP*)o)->op_last->op_type != OP_CONST)
                break;
            if ((o->op_private & (OPpLVAL_INTRO))
                || ((BINOP*)o)->op_last->op_type != OP_CONST)
                break;
@@ -6157,7 +6591,7 @@ Perl_peep(pTHX_ register OP *o)
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
                break;
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
                break;
-           svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+           svp = cSVOPx_svp(((BINOP*)o)->op_last);
            key = SvPV(*svp, keylen);
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
            key = SvPV(*svp, keylen);
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
@@ -6171,8 +6605,76 @@ Perl_peep(pTHX_ register OP *o)
            rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
            o->op_type = OP_AELEM;
            o->op_ppaddr = PL_ppaddr[OP_AELEM];
            rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
            o->op_type = OP_AELEM;
            o->op_ppaddr = PL_ppaddr[OP_AELEM];
+           sv = newSViv(ind);
+           if (SvREADONLY(*svp))
+               SvREADONLY_on(sv);
+           SvFLAGS(sv) |= (SvFLAGS(*svp)
+                           & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY));
            SvREFCNT_dec(*svp);
            SvREFCNT_dec(*svp);
-           *svp = newSViv(ind);
+           *svp = sv;
+           break;
+       }
+       
+       case OP_HSLICE: {
+           UNOP *rop;
+           SV *lexname;
+           GV **fields;
+           SV **svp, **indsvp, *sv;
+           I32 ind;
+           char *key;
+           STRLEN keylen;
+           SVOP *first_key_op, *key_op;
+
+           o->op_seq = PL_op_seqmax++;
+           if ((o->op_private & (OPpLVAL_INTRO))
+               /* I bet there's always a pushmark... */
+               || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST)
+               /* hmmm, no optimization if list contains only one key. */
+               break;
+           rop = (UNOP*)((LISTOP*)o)->op_last;
+           if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+               break;
+           lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
+           if (!SvOBJECT(lexname))
+               break;
+           fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+           if (!fields || !GvHV(*fields))
+               break;
+           /* Again guessing that the pushmark can be jumped over.... */
+           first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling)
+               ->op_first->op_sibling;
+           /* Check that the key list contains only constants. */
+           for (key_op = first_key_op; key_op;
+                key_op = (SVOP*)key_op->op_sibling)
+               if (key_op->op_type != OP_CONST)
+                   break;
+           if (key_op)
+               break;
+           rop->op_type = OP_RV2AV;
+           rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
+           o->op_type = OP_ASLICE;
+           o->op_ppaddr = PL_ppaddr[OP_ASLICE];
+           for (key_op = first_key_op; key_op;
+                key_op = (SVOP*)key_op->op_sibling) {
+               svp = cSVOPx_svp(key_op);
+               key = SvPV(*svp, keylen);
+               indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+               if (!indsvp) {
+                   Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
+                              "in variable %s of type %s",
+                         key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
+               }
+               ind = SvIV(*indsvp);
+               if (ind < 1)
+                   Perl_croak(aTHX_ "Bad index while coercing array into hash");
+               sv = newSViv(ind);
+               if (SvREADONLY(*svp))
+                   SvREADONLY_on(sv);
+               SvFLAGS(sv) |= (SvFLAGS(*svp)
+                               & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY));
+               SvREFCNT_dec(*svp);
+               *svp = sv;
+           }
            break;
        }
 
            break;
        }
 
Unnamed repository; edit this file 'description' to name the repository.