This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
missing integration in previous change
[perl5.git] / pp_hot.c
index cca05f7..0785f5f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,6 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, 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.
 #ifdef I_UNISTD
 #include <unistd.h>
 #endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#define HOP(pos,off) (IN_UTF8 ? utf8_hop(pos, off) : (pos + off))
 
 /* Hot code. */
 
@@ -33,10 +41,10 @@ unset_cvowner(void *cvarg)
     dTHR;
 #endif /* DEBUGGING */
 
-    DEBUG_L((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
+    DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
                           thr, cv, SvPEEK((SV*)cv))));
     MUTEX_LOCK(CvMUTEXP(cv));
-    DEBUG_L(if (CvDEPTH(cv) != 0)
+    DEBUG_S(if (CvDEPTH(cv) != 0)
                PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
                              CvDEPTH(cv)););
     assert(thr == CvOWNER(cv));
@@ -194,7 +202,23 @@ PP(pp_padsv)
 
 PP(pp_readline)
 {
+    tryAMAGICunTARGET(iter, 0);
     PL_last_in_gv = (GV*)(*PL_stack_sp--);
+    if (PL_op->op_flags & OPf_SPECIAL) {       /* Are called as <$var> */
+       if (SvROK(PL_last_in_gv)) {
+           if (SvTYPE(SvRV(PL_last_in_gv)) != SVt_PVGV) 
+               goto hard_way;
+           PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
+       } else if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
+         hard_way: {
+           dSP;
+           XPUSHs((SV*)PL_last_in_gv);
+           PUTBACK;
+           pp_rv2gv(ARGS);
+           PL_last_in_gv = (GV*)(*PL_stack_sp--);
+         }
+       }
+    }
     return do_readline();
 }
 
@@ -212,7 +236,7 @@ PP(pp_preinc)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       croak(no_modify);
+       croak(PL_no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
     {
@@ -284,7 +308,7 @@ PP(pp_pushre)
     Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
     XPUSHs(sv);
 #else
-    XPUSHs((SV*)op);
+    XPUSHs((SV*)PL_op);
 #endif
     RETURN;
 }
@@ -298,12 +322,13 @@ PP(pp_print)
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
     else
        gv = PL_defoutgv;
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
        if (MARK == ORIGMARK) {
            /* If using default handle then we need to make space to 
             * pass object as 1st arg, so move other args up ...
@@ -314,7 +339,7 @@ PP(pp_print)
            ++SP;
        }
        PUSHMARK(MARK - 1);
-       *MARK = mg->mg_obj;
+       *MARK = SvTIED_obj((SV*)gv, mg);
        PUTBACK;
        ENTER;
        perl_call_method("PRINT", G_SCALAR);
@@ -326,23 +351,25 @@ PP(pp_print)
        RETURN;
     }
     if (!(io = GvIO(gv))) {
-       if (PL_dowarn) {
+       if (ckWARN(WARN_UNOPENED)) {
            SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
-            warn("Filehandle %s never opened", SvPV(sv,PL_na));
+            warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
         }
 
        SETERRNO(EBADF,RMS$_IFI);
        goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
-       if (PL_dowarn)  {
+       if (ckWARN2(WARN_CLOSED, WARN_IO))  {
            SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
            if (IoIFP(io))
-               warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
-           else
-               warn("print on closed filehandle %s", SvPV(sv,PL_na));
+               warner(WARN_IO, "Filehandle %s opened only for input", 
+                               SvPV(sv,n_a));
+           else if (ckWARN(WARN_CLOSED))
+               warner(WARN_CLOSED, "print on closed filehandle %s", 
+                               SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -393,16 +420,18 @@ PP(pp_print)
 
 PP(pp_rv2av)
 {
-    djSP; dPOPss;
+    djSP; dTOPss;
     AV *av;
 
     if (SvROK(sv)) {
       wasref:
+       tryAMAGICunDEREF(to_av);
+
        av = (AV*)SvRV(sv);
        if (SvTYPE(av) != SVt_PVAV)
            DIE("Not an ARRAY reference");
        if (PL_op->op_flags & OPf_REF) {
-           PUSHs((SV*)av);
+           SETs((SV*)av);
            RETURN;
        }
     }
@@ -410,7 +439,7 @@ PP(pp_rv2av)
        if (SvTYPE(sv) == SVt_PVAV) {
            av = (AV*)sv;
            if (PL_op->op_flags & OPf_REF) {
-               PUSHs((SV*)av);
+               SETs((SV*)av);
                RETURN;
            }
        }
@@ -419,6 +448,7 @@ PP(pp_rv2av)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -428,25 +458,37 @@ PP(pp_rv2av)
                if (!SvOK(sv)) {
                    if (PL_op->op_flags & OPf_REF ||
                      PL_op->op_private & HINT_STRICT_REFS)
-                       DIE(no_usym, "an ARRAY");
-                   if (PL_dowarn)
-                       warn(warn_uninit);
-                   if (GIMME == G_ARRAY)
+                       DIE(PL_no_usym, "an ARRAY");
+                   if (ckWARN(WARN_UNINITIALIZED))
+                       warner(WARN_UNINITIALIZED, PL_warn_uninit);
+                   if (GIMME == G_ARRAY) {
+                       (void)POPs;
                        RETURN;
-                   RETPUSHUNDEF;
+                   }
+                   RETSETUNDEF;
                }
-               sym = SvPV(sv,PL_na);
-               if (PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(no_symref, sym, "an ARRAY");
-               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
-           } else {
+               sym = SvPV(sv,n_a);
+               if ((PL_op->op_flags & OPf_SPECIAL) &&
+                   !(PL_op->op_flags & OPf_MOD))
+               {
+                   gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
+                   if (!gv)
+                       RETSETUNDEF;
+               }
+               else {
+                   if (PL_op->op_private & HINT_STRICT_REFS)
+                       DIE(PL_no_symref, sym, "an ARRAY");
+                   gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+               }
+           }
+           else {
                gv = (GV*)sv;
            }
            av = GvAVn(gv);
            if (PL_op->op_private & OPpLVAL_INTRO)
                av = save_ary(gv);
            if (PL_op->op_flags & OPf_REF) {
-               PUSHs((SV*)av);
+               SETs((SV*)av);
                RETURN;
            }
        }
@@ -454,6 +496,7 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
        I32 maxarg = AvFILL(av) + 1;
+       (void)POPs;                     /* XXXX May be optimized away? */
        EXTEND(SP, maxarg);          
        if (SvRMAGICAL(av)) {
            U32 i; 
@@ -470,7 +513,7 @@ PP(pp_rv2av)
     else {
        dTARGET;
        I32 maxarg = AvFILL(av) + 1;
-       PUSHi(maxarg);
+       SETi(maxarg);
     }
     RETURN;
 }
@@ -482,6 +525,8 @@ PP(pp_rv2hv)
 
     if (SvROK(sv)) {
       wasref:
+       tryAMAGICunDEREF(to_hv);
+
        hv = (HV*)SvRV(sv);
        if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
            DIE("Not a HASH reference");
@@ -503,6 +548,7 @@ PP(pp_rv2hv)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -512,20 +558,30 @@ PP(pp_rv2hv)
                if (!SvOK(sv)) {
                    if (PL_op->op_flags & OPf_REF ||
                      PL_op->op_private & HINT_STRICT_REFS)
-                       DIE(no_usym, "a HASH");
-                   if (PL_dowarn)
-                       warn(warn_uninit);
+                       DIE(PL_no_usym, "a HASH");
+                   if (ckWARN(WARN_UNINITIALIZED))
+                       warner(WARN_UNINITIALIZED, PL_warn_uninit);
                    if (GIMME == G_ARRAY) {
                        SP--;
                        RETURN;
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,PL_na);
-               if (PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(no_symref, sym, "a HASH");
-               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
-           } else {
+               sym = SvPV(sv,n_a);
+               if ((PL_op->op_flags & OPf_SPECIAL) &&
+                   !(PL_op->op_flags & OPf_MOD))
+               {
+                   gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
+                   if (!gv)
+                       RETSETUNDEF;
+               }
+               else {
+                   if (PL_op->op_private & HINT_STRICT_REFS)
+                       DIE(PL_no_symref, sym, "a HASH");
+                   gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+               }
+           }
+           else {
                gv = (GV*)sv;
            }
            hv = GvHVn(gv);
@@ -583,6 +639,7 @@ PP(pp_aassign)
      * clobber a value on the right that's used later in the list.
      */
     if (PL_op->op_private & OPpASSIGN_COMMON) {
+       EXTEND_MORTAL(lastrelem - firstrelem + 1);
         for (relem = firstrelem; relem <= lastrelem; relem++) {
             /*SUPPRESS 560*/
             if (sv = *relem) {
@@ -618,7 +675,7 @@ PP(pp_aassign)
                    if (SvSMAGICAL(sv))
                        mg_set(sv);
                    if (!didstore)
-                       SvREFCNT_dec(sv);
+                       sv_2mortal(sv);
                }
                TAINT_NOT;
            }
@@ -645,21 +702,21 @@ PP(pp_aassign)
                        if (SvSMAGICAL(tmpstr))
                            mg_set(tmpstr);
                        if (!didstore)
-                           SvREFCNT_dec(tmpstr);
+                           sv_2mortal(tmpstr);
                    }
                    TAINT_NOT;
                }
                if (relem == lastrelem) {
                    if (*relem) {
                        HE *didstore;
-                       if (PL_dowarn) {
+                       if (ckWARN(WARN_UNSAFE)) {
                            if (relem == firstrelem &&
                                SvROK(*relem) &&
                                ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
                                  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
-                               warn("Reference found where even-sized list expected");
+                               warner(WARN_UNSAFE, "Reference found where even-sized list expected");
                            else
-                               warn("Odd number of elements in hash assignment");
+                               warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
                        }
                        tmpstr = NEWSV(29,0);
                        didstore = hv_store_ent(hash,*relem,tmpstr,0);
@@ -667,7 +724,7 @@ PP(pp_aassign)
                            if (SvSMAGICAL(tmpstr))
                                mg_set(tmpstr);
                            if (!didstore)
-                               SvREFCNT_dec(tmpstr);
+                               sv_2mortal(tmpstr);
                        }
                        TAINT_NOT;
                    }
@@ -679,7 +736,7 @@ PP(pp_aassign)
            if (SvTHINKFIRST(sv)) {
                if (SvREADONLY(sv) && PL_curcop != &PL_compiling) {
                    if (!SvIMMORTAL(sv))
-                       DIE(no_modify);
+                       DIE(PL_no_modify);
                    if (relem <= lastrelem)
                        relem++;
                    break;
@@ -798,7 +855,7 @@ PP(pp_match)
     register char *s;
     char *strend;
     I32 global;
-    I32 safebase;
+    I32 r_flags = 0;
     char *truebase;
     register REGEXP *rx = pm->op_pmregexp;
     bool rxtainted;
@@ -807,7 +864,7 @@ PP(pp_match)
     I32 minmatch = 0;
     I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
-    SV *screamer;
+    I32 had_zerolen = 0;
 
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
@@ -837,25 +894,33 @@ PP(pp_match)
     }
     if (rx->minlen > len) goto failure;
 
-    screamer = ( (SvSCREAM(TARG) && rx->check_substr
-                 && SvTYPE(rx->check_substr) == SVt_PVBM
-                 && SvVALID(rx->check_substr)) 
-               ? TARG : Nullsv);
     truebase = t = s;
+
+    /* XXXX What part of this is needed with true \G-support? */
     if (global = pm->op_pmflags & PMf_GLOBAL) {
        rx->startp[0] = 0;
        if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
            MAGIC* mg = mg_find(TARG, 'g');
            if (mg && mg->mg_len >= 0) {
-               rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+               if (!(rx->reganch & ROPT_GPOS_SEEN))
+                   rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+               else if (rx->reganch & ROPT_ANCH_GPOS) {
+                   r_flags |= REXEC_IGNOREPOS;
+                   rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+               }
                minmatch = (mg->mg_flags & MGf_MINMATCH);
                update_minmatch = 0;
            }
        }
     }
-    safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
-               && !PL_sawampersand);
-    safebase = safebase ? 0  : REXEC_COPY_STR ;
+    if ((gimme != G_ARRAY && !global && rx->nparens)
+           || SvTEMP(TARG) || PL_sawampersand)
+       r_flags |= REXEC_COPY_STR;
+    if (SvSCREAM(TARG) && rx->check_substr
+       && SvTYPE(rx->check_substr) == SVt_PVBM
+       && SvVALID(rx->check_substr)) 
+       r_flags |= REXEC_SCREAM;
+
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
        SAVEINT(PL_multiline);
        PL_multiline = pm->op_pmflags & PMf_MULTILINE;
@@ -867,23 +932,26 @@ play_it_again:
        if ((s + rx->minlen) > strend)
            goto nope;
        if (update_minmatch++)
-           minmatch = (s == rx->startp[0]);
+           minmatch = had_zerolen;
     }
     if (rx->check_substr) {
        if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
-           if ( screamer ) {
+           if (r_flags & REXEC_SCREAM) {
                I32 p = -1;
+               char *b;
                
                if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
                    goto nope;
-               else if (!(s = screaminstr(TARG, rx->check_substr, 
-                                          rx->check_offset_min, 0, &p, 0)))
+
+               b = (char*)HOP((U8*)s, rx->check_offset_min);
+               if (!(s = screaminstr(TARG, rx->check_substr, b - s, 0, &p, 0)))
                    goto nope;
-               else if ((rx->reganch & ROPT_CHECK_ALL)
+
+               if ((rx->reganch & ROPT_CHECK_ALL)
                         && !PL_sawampersand && !SvTAIL(rx->check_substr))
                    goto yup;
            }
-           else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
+           else if (!(s = fbm_instr((unsigned char*)HOP((U8*)s, rx->check_offset_min),
                                     (unsigned char*)strend, 
                                     rx->check_substr, 0)))
                goto nope;
@@ -891,7 +959,7 @@ play_it_again:
                goto yup;
            if (s && rx->check_offset_max < s - t) {
                ++BmUSEFUL(rx->check_substr);
-               s -= rx->check_offset_max;
+               s = (char*)HOP((U8*)s, -rx->check_offset_max);
            }
            else
                s = t;
@@ -900,21 +968,20 @@ play_it_again:
           beginning of match, and the match is anchored at s. */
        else if (!PL_multiline) {       /* Anchored near beginning of string. */
            I32 slen;
-           if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
+           char *b = (char*)HOP((U8*)s, rx->check_offset_min);
+           if (*SvPVX(rx->check_substr) != *b
                || ((slen = SvCUR(rx->check_substr)) > 1
-                   && memNE(SvPVX(rx->check_substr), 
-                            s + rx->check_offset_min, slen)))
+                   && memNE(SvPVX(rx->check_substr), b, slen)))
                goto nope;
        }
-       if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0
+       if (!(rx->reganch & ROPT_NAUGHTY) && --BmUSEFUL(rx->check_substr) < 0
            && rx->check_substr == rx->float_substr) {
            SvREFCNT_dec(rx->check_substr);
            rx->check_substr = Nullsv;  /* opt is being useless */
            rx->float_substr = Nullsv;
        }
     }
-    if (CALLREGEXEC(rx, s, strend, truebase, minmatch,
-                     screamer, NULL, safebase))
+    if (CALLREGEXEC(rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
     {
        PL_curpm = pm;
        if (pm->op_pmflags & PMf_ONCE)
@@ -951,13 +1018,13 @@ play_it_again:
        if (global) {
            truebase = rx->subbeg;
            strend = rx->subend;
-           if (rx->startp[0] && rx->startp[0] == rx->endp[0])
-               ++rx->endp[0];
+           had_zerolen = (rx->startp[0] && rx->startp[0] == rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
+           r_flags |= REXEC_IGNOREPOS;
            goto play_it_again;
        }
        else if (!iters)
-           XPUSHs(&sv_yes);
+           XPUSHs(&PL_sv_yes);
        LEAVE_SCOPE(oldsave);
        RETURN;
     }
@@ -1042,9 +1109,9 @@ do_readline(void)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
        PUSHMARK(SP);
-       XPUSHs(mg->mg_obj);
+       XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
        PUTBACK;
        ENTER;
        perl_call_method("READLINE", gimme);
@@ -1063,7 +1130,7 @@ do_readline(void)
                    IoFLAGS(io) &= ~IOf_START;
                    IoLINES(io) = 0;
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
-                       do_open(PL_last_in_gv,"-",1,FALSE,0,0,Nullfp);
+                       do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
                        sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
                        SvSETMAGIC(GvSV(PL_last_in_gv));
                        fp = IoIFP(io);
@@ -1197,7 +1264,7 @@ do_readline(void)
 #endif /* !CSH */
 #endif /* !DOSISH */
                (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
-                             FALSE, 0, 0, Nullfp);
+                             FALSE, O_RDONLY, 0, Nullfp);
                fp = IoIFP(io);
 #endif /* !VMS */
                LEAVE;
@@ -1207,8 +1274,9 @@ do_readline(void)
            SP--;
     }
     if (!fp) {
-       if (PL_dowarn && io && !(IoFLAGS(io) & IOf_START))
-           warn("Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
+       if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START))
+           warner(WARN_CLOSED,
+                  "Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
        if (gimme == G_SCALAR) {
            (void)SvOK_off(TARG);
            PUSHTARG;
@@ -1233,8 +1301,18 @@ do_readline(void)
        sv = sv_2mortal(NEWSV(57, 80));
        offset = 0;
     }
+
+/* flip-flop EOF state for a snarfed empty file */
+#define SNARF_EOF(gimme,rs,io,sv) \
+    ((gimme != G_SCALAR || SvCUR(sv)                                   \
+      || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs))    \
+       ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE)                          \
+       : ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+
     for (;;) {
-       if (!sv_gets(sv, fp, offset)) {
+       if (!sv_gets(sv, fp, offset)
+           && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
+       {
            PerlIO_clearerr(fp);
            if (IoFLAGS(io) & IOf_ARGV) {
                fp = nextargv(PL_last_in_gv);
@@ -1244,8 +1322,12 @@ do_readline(void)
                IoFLAGS(io) |= IOf_START;
            }
            else if (type == OP_GLOB) {
-               if (do_close(PL_last_in_gv, FALSE) & ~0xFF)
-                   warn("internal error: glob failed");
+               if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
+                   warner(WARN_CLOSED,
+                          "glob failed (child exited with status %d%s)",
+                          STATUS_CURRENT >> 8,
+                          (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
+               }
            }
            if (gimme == G_SCALAR) {
                (void)SvOK_off(TARG);
@@ -1337,6 +1419,8 @@ PP(pp_helem)
        svp = he ? &HeVAL(he) : 0;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
+       if (PL_op->op_private & OPpLVAL_INTRO)
+           DIE("Can't localize pseudo-hash element");
        svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
     }
     else {
@@ -1346,8 +1430,10 @@ PP(pp_helem)
        if (!svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
-           if (!defer)
-               DIE(no_helem, SvPV(keysv, PL_na));
+           if (!defer) {
+               STRLEN n_a;
+               DIE(PL_no_helem, SvPV(keysv, n_a));
+           }
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
            LvTYPE(lv) = 'y';
@@ -1445,7 +1531,7 @@ PP(pp_iter)
 
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
-    if (cx->cx_type != CXt_LOOP)
+    if (CxTYPE(cx) != CXt_LOOP)
        DIE("panic: pp_iter");
 
     av = cx->blk_loop.iterary;
@@ -1458,7 +1544,9 @@ PP(pp_iter)
            char *max = SvPV((SV*)av, maxlen);
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
 #ifndef USE_THREADS                      /* don't risk potential race */
-               if (SvREFCNT(*cx->blk_loop.itervar) == 1) {
+               if (SvREFCNT(*cx->blk_loop.itervar) == 1
+                   && !SvMAGICAL(*cx->blk_loop.itervar))
+               {
                    /* safe to reuse old SV */
                    sv_setsv(*cx->blk_loop.itervar, cur);
                }
@@ -1484,7 +1572,9 @@ PP(pp_iter)
            RETPUSHNO;
 
 #ifndef USE_THREADS                      /* don't risk potential race */
-       if (SvREFCNT(*cx->blk_loop.itervar) == 1) {
+       if (SvREFCNT(*cx->blk_loop.itervar) == 1
+           && !SvMAGICAL(*cx->blk_loop.itervar))
+       {
            /* safe to reuse old SV */
            sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
        }
@@ -1554,13 +1644,12 @@ PP(pp_subst)
     bool once;
     bool rxtainted;
     char *orig;
-    I32 safebase;
+    I32 r_flags;
     register REGEXP *rx = pm->op_pmregexp;
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
-    SV *screamer;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1573,7 +1662,7 @@ PP(pp_subst)
     if (SvREADONLY(TARG)
        || (SvTYPE(TARG) > SVt_PVLV
            && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
-       croak(no_modify);
+       croak(PL_no_modify);
     PUTBACK;
 
     s = SvPV(TARG, len);
@@ -1598,11 +1687,12 @@ PP(pp_subst)
        pm = PL_curpm;
        rx = pm->op_pmregexp;
     }
-    screamer = ( (SvSCREAM(TARG) && rx->check_substr
+    r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+               ? REXEC_COPY_STR : 0;
+    if (SvSCREAM(TARG) && rx->check_substr
                  && SvTYPE(rx->check_substr) == SVt_PVBM
-                 && SvVALID(rx->check_substr)) 
-               ? TARG : Nullsv);
-    safebase = (!rx->nparens && !PL_sawampersand) ? 0 : REXEC_COPY_STR;
+                 && SvVALID(rx->check_substr))
+       r_flags |= REXEC_SCREAM;
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
        SAVEINT(PL_multiline);
        PL_multiline = pm->op_pmflags & PMf_MULTILINE;
@@ -1610,21 +1700,24 @@ PP(pp_subst)
     orig = m = s;
     if (rx->check_substr) {
        if (!(rx->reganch & ROPT_NOSCAN)) { /* It floats. */
-           if (screamer) {
+           if (r_flags & REXEC_SCREAM) {
                I32 p = -1;
+               char *b;
                
                if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
                    goto nope;
-               else if (!(s = screaminstr(TARG, rx->check_substr, rx->check_offset_min, 0, &p, 0)))
+
+               b = (char*)HOP((U8*)s, rx->check_offset_min);
+               if (!(s = screaminstr(TARG, rx->check_substr, b - s, 0, &p, 0)))
                    goto nope;
            }
-           else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min
+           else if (!(s = fbm_instr((unsigned char*)HOP((U8*)s, rx->check_offset_min)
                                     (unsigned char*)strend,
                                     rx->check_substr, 0)))
                goto nope;
            if (s && rx->check_offset_max < s - m) {
                ++BmUSEFUL(rx->check_substr);
-               s -= rx->check_offset_max;
+               s = (char*)HOP((U8*)s, -rx->check_offset_max);
            }
            else
                s = m;
@@ -1633,13 +1726,13 @@ PP(pp_subst)
           beginning of match, and the match is anchored at s. */
        else if (!PL_multiline) { /* Anchored at beginning of string. */
            I32 slen;
-           if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
+           char *b = (char*)HOP((U8*)s, rx->check_offset_min);
+           if (*SvPVX(rx->check_substr) != *b
                || ((slen = SvCUR(rx->check_substr)) > 1
-                   && memNE(SvPVX(rx->check_substr), 
-                            s + rx->check_offset_min, slen)))
+                   && memNE(SvPVX(rx->check_substr), b, slen)))
                goto nope;
        }
-       if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0
+       if (!(rx->reganch & ROPT_NAUGHTY) && --BmUSEFUL(rx->check_substr) < 0
            && rx->check_substr == rx->float_substr) {
            SvREFCNT_dec(rx->check_substr);
            rx->check_substr = Nullsv;  /* opt is being useless */
@@ -1654,9 +1747,9 @@ PP(pp_subst)
     c = dstr ? SvPV(dstr, clen) : Nullch;
 
     /* can do inplace substitution? */
-    if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
+    if (c && clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
        && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
-       if (!CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+       if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
            SPAGAIN;
            PUSHs(&PL_sv_no);
            LEAVE_SCOPE(oldsave);
@@ -1756,7 +1849,7 @@ PP(pp_subst)
        RETURN;
     }
 
-    if (CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+    if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
        if (force_on_match) {
            force_on_match = 0;
            s = SvPV_force(TARG, len);
@@ -1772,6 +1865,7 @@ PP(pp_subst)
            PUSHSUBST(cx);
            RETURNOP(cPMOP->op_pmreplroot);
        }
+       r_flags |= REXEC_IGNOREPOS;
        do {
            if (iters++ > maxiters)
                DIE("Substitution loop");
@@ -1790,7 +1884,7 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
+       } while (CALLREGEXEC(rx, s, strend, orig, s == m, TARG, NULL, r_flags));
        sv_catpvn(dstr, s, strend - s);
 
        (void)SvOOK_off(TARG);
@@ -1968,6 +2062,7 @@ PP(pp_entersub)
     default:
        if (!SvROK(sv)) {
            char *sym;
+           STRLEN n_a;
 
            if (sv == &PL_sv_yes) {             /* unfound import, ignore */
                if (hasargs)
@@ -1979,14 +2074,18 @@ PP(pp_entersub)
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
            else
-               sym = SvPV(sv, PL_na);
+               sym = SvPV(sv, n_a);
            if (!sym)
-               DIE(no_usym, "a subroutine");
+               DIE(PL_no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(no_symref, sym, "a subroutine");
+               DIE(PL_no_symref, sym, "a subroutine");
            cv = perl_get_cv(sym, TRUE);
            break;
        }
+       {
+           SV **sp = &sv;              /* Used in tryAMAGICunDEREF macro. */
+           tryAMAGICunDEREF(to_cv);
+       }       
        cv = (CV*)SvRV(sv);
        if (SvTYPE(cv) == SVt_PVCV)
            break;
@@ -2056,8 +2155,13 @@ PP(pp_entersub)
            if (SP > PL_stack_base + TOPMARK)
                sv = *(PL_stack_base + TOPMARK + 1);
            else {
-               MUTEX_UNLOCK(CvMUTEXP(cv));
-               croak("no argument for locked method call");
+               AV *av = (AV*)PL_curpad[0];
+               if (hasargs || !av || AvFILLp(av) < 0
+                   || !(sv = AvARRAY(av)[0]))
+               {
+                   MUTEX_UNLOCK(CvMUTEXP(cv));
+                   croak("no argument for locked method call");
+               }
            }
            if (SvROK(sv))
                sv = SvRV(sv);
@@ -2079,10 +2183,9 @@ PP(pp_entersub)
            while (MgOWNER(mg))
                COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
            MgOWNER(mg) = thr;
-           DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
+           DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
                                  thr, sv);)
            MUTEX_UNLOCK(MgMUTEXP(mg));
-           SvREFCNT_inc(sv);   /* Keep alive until magic_mutexfree */
            save_destructor(unlock_condpair, sv);
        }
        MUTEX_LOCK(CvMUTEXP(cv));
@@ -2117,13 +2220,12 @@ PP(pp_entersub)
         * (3) instead of (2) so we'd have to clone. Would the fact
         * that we released the mutex more quickly make up for this?
         */
-       if (PL_threadnum &&
-           (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+       if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
        {
            /* We already have a clone to use */
            MUTEX_UNLOCK(CvMUTEXP(cv));
            cv = *(CV**)svp;
-           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                                  "entersub: %p already has clone %p:%s\n",
                                  thr, cv, SvPEEK((SV*)cv)));
            CvOWNER(cv) = thr;
@@ -2137,7 +2239,7 @@ PP(pp_entersub)
                CvOWNER(cv) = thr;
                SvREFCNT_inc(cv);
                MUTEX_UNLOCK(CvMUTEXP(cv));
-               DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+               DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                            "entersub: %p grabbing %p:%s in stash %s\n",
                            thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
                                HvNAME(CvSTASH(cv)) : "(none)"));
@@ -2146,7 +2248,7 @@ PP(pp_entersub)
                CV *clonecv;
                SvREFCNT_inc(cv); /* don't let it vanish from under us */
                MUTEX_UNLOCK(CvMUTEXP(cv));
-               DEBUG_L((PerlIO_printf(PerlIO_stderr(),
+               DEBUG_S((PerlIO_printf(PerlIO_stderr(),
                                       "entersub: %p cloning %p:%s\n",
                                       thr, cv, SvPEEK((SV*)cv))));
                /*
@@ -2163,7 +2265,7 @@ PP(pp_entersub)
                cv = clonecv;
                SvREFCNT_inc(cv);
            }
-           DEBUG_L(if (CvDEPTH(cv) != 0)
+           DEBUG_S(if (CvDEPTH(cv) != 0)
                        PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
                                      CvDEPTH(cv)););
            SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
@@ -2245,12 +2347,14 @@ PP(pp_entersub)
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
        CvDEPTH(cv)++;
+       /* XXX This would be a natural place to set C<PL_compcv = cv> so
+        * that eval'' ops within this sub know the correct lexical space.
+        * Owing the speed considerations, we choose to search for the cv
+        * in doeval() instead.
+        */
        if (CvDEPTH(cv) < 2)
            (void)SvREFCNT_inc(cv);
        else {  /* save temporaries on recursion? */
-           if (CvDEPTH(cv) == 100 && PL_dowarn 
-                 && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
-               sub_crush_depth(cv);
            if (CvDEPTH(cv) > AvFILLp(padlist)) {
                AV *av;
                AV *newpad = newAV();
@@ -2313,7 +2417,7 @@ PP(pp_entersub)
            SV** ary;
 
 #if 0
-           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                                  "%p entersub preparing @_\n", thr));
 #endif
            av = (AV*)PL_curpad[0];
@@ -2350,8 +2454,15 @@ PP(pp_entersub)
                MARK++;
            }
        }
+       /* warning must come *after* we fully set up the context
+        * stuff so that __WARN__ handlers can safely dounwind()
+        * if they want to
+        */
+       if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
+           && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+           sub_crush_depth(cv);
 #if 0
-       DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+       DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                              "%p entersub returning %p\n", thr, CvSTART(cv)));
 #endif
        RETURNOP(CvSTART(cv));
@@ -2362,11 +2473,12 @@ void
 sub_crush_depth(CV *cv)
 {
     if (CvANON(cv))
-       warn("Deep recursion on anonymous subroutine");
+       warner(WARN_RECURSION, "Deep recursion on anonymous subroutine");
     else {
        SV* tmpstr = sv_newmortal();
        gv_efullname3(tmpstr, CvGV(cv), Nullch);
-       warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr));
+       warner(WARN_RECURSION, "Deep recursion on subroutine \"%s\"", 
+               SvPVX(tmpstr));
     }
 }
 
@@ -2389,7 +2501,7 @@ PP(pp_aelem)
        if (!svp || *svp == &PL_sv_undef) {
            SV* lv;
            if (!defer)
-               DIE(no_aelem, elem);
+               DIE(PL_no_aelem, elem);
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
            LvTYPE(lv) = 'y';
@@ -2419,7 +2531,7 @@ vivify_ref(SV *sv, U32 to_what)
        mg_get(sv);
     if (!SvOK(sv)) {
        if (SvREADONLY(sv))
-           croak(no_modify);
+           croak(PL_no_modify);
        if (SvTYPE(sv) < SVt_RV)
            sv_upgrade(sv, SVt_RV);
        else if (SvTYPE(sv) >= SVt_PV) {
@@ -2462,7 +2574,7 @@ PP(pp_method)
        }
     }
 
-    name = SvPV(TOPs, PL_na);
+    name = SvPV(TOPs, packlen);
     sv = *(PL_stack_base + TOPMARK + 1);
     
     if (SvGMAGICAL(sv))
@@ -2478,10 +2590,16 @@ PP(pp_method)
            !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
            !(ob=(SV*)GvIO(iogv)))
        {
-           if (!packname || !isIDFIRST(*packname))
+           if (!packname || 
+               ((*(U8*)packname >= 0xc0 && IN_UTF8)
+                   ? !isIDFIRST_utf8((U8*)packname)
+                   : !isIDFIRST(*packname)
+               ))
+           {
                DIE("Can't call method \"%s\" %s", name,
                    SvOK(sv)? "without a package or object reference"
                            : "on an undefined value");
+           }
            stash = gv_stashpvn(packname, packlen, TRUE);
            goto fetch;
        }