X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=1956d76f752a9797ecccbce754f10d4693593ef9;hb=dcc96bbd648270d5e7184f192cb9bada22ded67e;hp=b52563a38f30b0c6d54d66c496e47d770391c84e;hpb=ee027f1d663256f1223632e02ff1c8835809ce91;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index b52563a..1956d76 100644
--- 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.
@@ -16,34 +16,25 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_PP_HOT_C
 #include "perl.h"
 
 #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. */
 
 #ifdef USE_THREADS
-static void
-unset_cvowner(void *cvarg)
-{
-    register CV* cv = (CV *) cvarg;
-#ifdef DEBUGGING
-    dTHR;
-#endif /* DEBUGGING */
-
-    DEBUG_L((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)
-		PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
-			      CvDEPTH(cv)););
-    assert(thr == CvOWNER(cv));
-    CvOWNER(cv) = 0;
-    MUTEX_UNLOCK(CvMUTEXP(cv));
-    SvREFCNT_dec(cv);
-}
+static void unset_cvowner(pTHXo_ void *cvarg);
 #endif /* USE_THREADS */
 
 PP(pp_const)
@@ -55,9 +46,9 @@ PP(pp_const)
 
 PP(pp_nextstate)
 {
-    curcop = (COP*)op;
+    PL_curcop = (COP*)PL_op;
     TAINT_NOT;		/* Each statement is presumed innocent */
-    stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+    PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
     return NORMAL;
 }
@@ -66,7 +57,7 @@ PP(pp_gvsv)
 {
     djSP;
     EXTEND(SP,1);
-    if (op->op_private & OPpLVAL_INTRO)
+    if (PL_op->op_private & OPpLVAL_INTRO)
 	PUSHs(save_scalar(cGVOP->op_gv));
     else
 	PUSHs(GvSV(cGVOP->op_gv));
@@ -78,9 +69,15 @@ PP(pp_null)
     return NORMAL;
 }
 
+PP(pp_setstate)
+{
+    PL_curcop = (COP*)PL_op;
+    return NORMAL;
+}
+
 PP(pp_pushmark)
 {
-    PUSHMARK(stack_sp);
+    PUSHMARK(PL_stack_sp);
     return NORMAL;
 }
 
@@ -118,11 +115,11 @@ PP(pp_sassign)
     djSP; dPOPTOPssrl;
     MAGIC *mg;
 
-    if (op->op_private & OPpASSIGN_BACKWARDS) {
+    if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
 	SV *temp;
 	temp = left; left = right; right = temp;
     }
-    if (tainting && tainted && !SvTAINTED(left))
+    if (PL_tainting && PL_tainted && !SvTAINTED(left))
 	TAINT_NOT;
     SvSetMagicSV(right, left);
     SETs(right);
@@ -133,18 +130,18 @@ PP(pp_cond_expr)
 {
     djSP;
     if (SvTRUEx(POPs))
-	RETURNOP(cCONDOP->op_true);
+	RETURNOP(cLOGOP->op_other);
     else
-	RETURNOP(cCONDOP->op_false);
+	RETURNOP(cLOGOP->op_next);
 }
 
 PP(pp_unstack)
 {
     I32 oldsave;
     TAINT_NOT;		/* Each statement is presumed innocent */
-    stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+    PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
-    oldsave = scopestack[scopestack_ix - 1];
+    oldsave = PL_scopestack[PL_scopestack_ix - 1];
     LEAVE_SCOPE(oldsave);
     return NORMAL;
 }
@@ -180,12 +177,12 @@ PP(pp_padsv)
 {
     djSP; dTARGET;
     XPUSHs(TARG);
-    if (op->op_flags & OPf_MOD) {
-	if (op->op_private & OPpLVAL_INTRO)
-	    SAVECLEARSV(curpad[op->op_targ]);
-        else if (op->op_private & OPpDEREF) {
+    if (PL_op->op_flags & OPf_MOD) {
+	if (PL_op->op_private & OPpLVAL_INTRO)
+	    SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+        else if (PL_op->op_private & OPpDEREF) {
 	    PUTBACK;
-	    vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
+	    vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF);
 	    SPAGAIN;
 	}
     }
@@ -194,7 +191,19 @@ PP(pp_padsv)
 
 PP(pp_readline)
 {
-    last_in_gv = (GV*)(*stack_sp--);
+    tryAMAGICunTARGET(iter, 0);
+    PL_last_in_gv = (GV*)(*PL_stack_sp--);
+    if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
+	if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV) 
+	    PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
+	else {
+	    dSP;
+	    XPUSHs((SV*)PL_last_in_gv);
+	    PUTBACK;
+	    pp_rv2gv();
+	    PL_last_in_gv = (GV*)(*PL_stack_sp--);
+	}
+    }
     return do_readline();
 }
 
@@ -212,8 +221,8 @@ PP(pp_preinc)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-	croak(no_modify);
-    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+	Perl_croak(aTHX_ PL_no_modify);
+    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MAX)
     {
 	++SvIVX(TOPs);
@@ -250,9 +259,9 @@ PP(pp_aelemfast)
 {
     djSP;
     AV *av = GvAV((GV*)cSVOP->op_sv);
-    U32 lval = op->op_flags & OPf_MOD;
-    SV** svp = av_fetch(av, op->op_private, lval);
-    SV *sv = (svp ? *svp : &sv_undef);
+    U32 lval = PL_op->op_flags & OPf_MOD;
+    SV** svp = av_fetch(av, PL_op->op_private, lval);
+    SV *sv = (svp ? *svp : &PL_sv_undef);
     EXTEND(SP, 1);
     if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
 	sv = sv_mortalcopy(sv);
@@ -281,10 +290,10 @@ PP(pp_pushre)
     SV* sv = sv_newmortal();
     sv_upgrade(sv, SVt_PVLV);
     LvTYPE(sv) = '/';
-    Copy(&op, &LvTARGOFF(sv), 1, OP*);
+    Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
     XPUSHs(sv);
 #else
-    XPUSHs((SV*)op);
+    XPUSHs((SV*)PL_op);
 #endif
     RETURN;
 }
@@ -298,12 +307,13 @@ PP(pp_print)
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_STACKED)
+    if (PL_op->op_flags & OPf_STACKED)
 	gv = (GV*)*++MARK;
     else
-	gv = defoutgv;
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+	gv = PL_defoutgv;
+    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,10 +324,10 @@ 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);
+	call_method("PRINT", G_SCALAR);
 	LEAVE;
 	SPAGAIN;
 	MARK = ORIGMARK + 1;
@@ -326,36 +336,39 @@ PP(pp_print)
 	RETURN;
     }
     if (!(io = GvIO(gv))) {
-	if (dowarn) {
+	if (ckWARN(WARN_UNOPENED)) {
 	    SV* sv = sv_newmortal();
-            gv_fullname3(sv, gv, Nullch);
-            warn("Filehandle %s never opened", SvPV(sv,na));
+	    gv_efullname3(sv, gv, Nullch);
+            Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
+			SvPV(sv,n_a));
         }
-
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
-	if (dowarn)  {
+	if (ckWARN2(WARN_CLOSED, WARN_IO))  {
 	    SV* sv = sv_newmortal();
-            gv_fullname3(sv, gv, Nullch);
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		warn("Filehandle %s opened only for input", SvPV(sv,na));
-	    else
-		warn("print on closed filehandle %s", SvPV(sv,na));
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV(sv,n_a));
+	    else if (ckWARN(WARN_CLOSED))
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "print on closed filehandle %s", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
     }
     else {
 	MARK++;
-	if (ofslen) {
+	if (PL_ofslen) {
 	    while (MARK <= SP) {
 		if (!do_print(*MARK, fp))
 		    break;
 		MARK++;
 		if (MARK <= SP) {
-		    if (PerlIO_write(fp, ofs, ofslen) == 0 || PerlIO_error(fp)) {
+		    if (PerlIO_write(fp, PL_ofs, PL_ofslen) == 0 || PerlIO_error(fp)) {
 			MARK--;
 			break;
 		    }
@@ -372,8 +385,8 @@ PP(pp_print)
 	if (MARK <= SP)
 	    goto just_say_no;
 	else {
-	    if (orslen)
-		if (PerlIO_write(fp, ors, orslen) == 0 || PerlIO_error(fp))
+	    if (PL_orslen)
+		if (PerlIO_write(fp, PL_ors, PL_orslen) == 0 || PerlIO_error(fp))
 		    goto just_say_no;
 
 	    if (IoFLAGS(io) & IOf_FLUSH)
@@ -382,35 +395,37 @@ PP(pp_print)
 	}
     }
     SP = ORIGMARK;
-    PUSHs(&sv_yes);
+    PUSHs(&PL_sv_yes);
     RETURN;
 
   just_say_no:
     SP = ORIGMARK;
-    PUSHs(&sv_undef);
+    PUSHs(&PL_sv_undef);
     RETURN;
 }
 
 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 (op->op_flags & OPf_REF) {
-	    PUSHs((SV*)av);
+	    DIE(aTHX_ "Not an ARRAY reference");
+	if (PL_op->op_flags & OPf_REF) {
+	    SETs((SV*)av);
 	    RETURN;
 	}
     }
     else {
 	if (SvTYPE(sv) == SVt_PVAV) {
 	    av = (AV*)sv;
-	    if (op->op_flags & OPf_REF) {
-		PUSHs((SV*)av);
+	    if (PL_op->op_flags & OPf_REF) {
+		SETs((SV*)av);
 		RETURN;
 	    }
 	}
@@ -419,6 +434,7 @@ PP(pp_rv2av)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
+		STRLEN n_a;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -426,27 +442,39 @@ PP(pp_rv2av)
 			goto wasref;
 		}
 		if (!SvOK(sv)) {
-		    if (op->op_flags & OPf_REF ||
-		      op->op_private & HINT_STRICT_REFS)
-			DIE(no_usym, "an ARRAY");
-		    if (dowarn)
-			warn(warn_uninit);
-		    if (GIMME == G_ARRAY)
+		    if (PL_op->op_flags & OPf_REF ||
+		      PL_op->op_private & HINT_STRICT_REFS)
+			DIE(aTHX_ PL_no_usym, "an ARRAY");
+		    if (ckWARN(WARN_UNINITIALIZED))
+			Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		    if (GIMME == G_ARRAY) {
+			(void)POPs;
 			RETURN;
-		    RETPUSHUNDEF;
+		    }
+		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,na);
-		if (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(aTHX_ PL_no_symref, sym, "an ARRAY");
+		    gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+		}
+	    }
+	    else {
 		gv = (GV*)sv;
 	    }
 	    av = GvAVn(gv);
-	    if (op->op_private & OPpLVAL_INTRO)
+	    if (PL_op->op_private & OPpLVAL_INTRO)
 		av = save_ary(gv);
-	    if (op->op_flags & OPf_REF) {
-		PUSHs((SV*)av);
+	    if (PL_op->op_flags & OPf_REF) {
+		SETs((SV*)av);
 		RETURN;
 	    }
 	}
@@ -454,12 +482,13 @@ 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; 
 	    for (i=0; i < maxarg; i++) {
 		SV **svp = av_fetch(av, i, FALSE);
-		SP[i+1] = (svp) ? *svp : &sv_undef;
+		SP[i+1] = (svp) ? *svp : &PL_sv_undef;
 	    }
 	} 
 	else {
@@ -470,7 +499,7 @@ PP(pp_rv2av)
     else {
 	dTARGET;
 	I32 maxarg = AvFILL(av) + 1;
-	PUSHi(maxarg);
+	SETi(maxarg);
     }
     RETURN;
 }
@@ -482,10 +511,12 @@ 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");
-	if (op->op_flags & OPf_REF) {
+	    DIE(aTHX_ "Not a HASH reference");
+	if (PL_op->op_flags & OPf_REF) {
 	    SETs((SV*)hv);
 	    RETURN;
 	}
@@ -493,7 +524,7 @@ PP(pp_rv2hv)
     else {
 	if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
 	    hv = (HV*)sv;
-	    if (op->op_flags & OPf_REF) {
+	    if (PL_op->op_flags & OPf_REF) {
 		SETs((SV*)hv);
 		RETURN;
 	    }
@@ -503,6 +534,7 @@ PP(pp_rv2hv)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
+		STRLEN n_a;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -510,28 +542,38 @@ PP(pp_rv2hv)
 			goto wasref;
 		}
 		if (!SvOK(sv)) {
-		    if (op->op_flags & OPf_REF ||
-		      op->op_private & HINT_STRICT_REFS)
-			DIE(no_usym, "a HASH");
-		    if (dowarn)
-			warn(warn_uninit);
+		    if (PL_op->op_flags & OPf_REF ||
+		      PL_op->op_private & HINT_STRICT_REFS)
+			DIE(aTHX_ PL_no_usym, "a HASH");
+		    if (ckWARN(WARN_UNINITIALIZED))
+			Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
 		    if (GIMME == G_ARRAY) {
 			SP--;
 			RETURN;
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,na);
-		if (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(aTHX_ PL_no_symref, sym, "a HASH");
+		    gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+		}
+	    }
+	    else {
 		gv = (GV*)sv;
 	    }
 	    hv = GvHVn(gv);
-	    if (op->op_private & OPpLVAL_INTRO)
+	    if (PL_op->op_private & OPpLVAL_INTRO)
 		hv = save_hash(gv);
-	    if (op->op_flags & OPf_REF) {
+	    if (PL_op->op_flags & OPf_REF) {
 		SETs((SV*)hv);
 		RETURN;
 	    }
@@ -539,15 +581,15 @@ PP(pp_rv2hv)
     }
 
     if (GIMME == G_ARRAY) { /* array wanted */
-	*stack_sp = (SV*)hv;
-	return do_kv(ARGS);
+	*PL_stack_sp = (SV*)hv;
+	return do_kv();
     }
     else {
 	dTARGET;
 	if (SvTYPE(hv) == SVt_PVAV)
 	    hv = avhv_keys((AV*)hv);
 	if (HvFILL(hv))
-	    sv_setpvf(TARG, "%ld/%ld",
+	    Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld",
 		      (long)HvFILL(hv), (long)HvMAX(hv) + 1);
 	else
 	    sv_setiv(TARG, 0);
@@ -560,9 +602,9 @@ PP(pp_rv2hv)
 PP(pp_aassign)
 {
     djSP;
-    SV **lastlelem = stack_sp;
-    SV **lastrelem = stack_base + POPMARK;
-    SV **firstrelem = stack_base + POPMARK + 1;
+    SV **lastlelem = PL_stack_sp;
+    SV **lastrelem = PL_stack_base + POPMARK;
+    SV **firstrelem = PL_stack_base + POPMARK + 1;
     SV **firstlelem = lastrelem + 1;
 
     register SV **relem;
@@ -576,13 +618,14 @@ PP(pp_aassign)
     I32 i;
     int magic;
 
-    delaymagic = DM_DELAY;		/* catch simultaneous items */
+    PL_delaymagic = DM_DELAY;		/* catch simultaneous items */
 
     /* If there's a common identifier on both sides we have to take
      * special care that assigning the identifier on the left doesn't
      * clobber a value on the right that's used later in the list.
      */
-    if (op->op_private & OPpASSIGN_COMMON) {
+    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 +661,7 @@ PP(pp_aassign)
 		    if (SvSMAGICAL(sv))
 			mg_set(sv);
 		    if (!didstore)
-			SvREFCNT_dec(sv);
+			sv_2mortal(sv);
 		}
 		TAINT_NOT;
 	    }
@@ -635,7 +678,7 @@ PP(pp_aassign)
 		    if (*relem)
 			sv = *(relem++);
 		    else
-			sv = &sv_no, relem++;
+			sv = &PL_sv_no, relem++;
 		    tmpstr = NEWSV(29,0);
 		    if (*relem)
 			sv_setsv(tmpstr,*relem);	/* value */
@@ -645,21 +688,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 (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");
+				Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
 			    else
-				warn("Odd number of elements in hash assignment");
+				Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
 			}
 			tmpstr = NEWSV(29,0);
 			didstore = hv_store_ent(hash,*relem,tmpstr,0);
@@ -667,7 +710,7 @@ PP(pp_aassign)
 			    if (SvSMAGICAL(tmpstr))
 				mg_set(tmpstr);
 			    if (!didstore)
-				SvREFCNT_dec(tmpstr);
+				sv_2mortal(tmpstr);
 			}
 			TAINT_NOT;
 		    }
@@ -676,89 +719,83 @@ PP(pp_aassign)
 	    }
 	    break;
 	default:
-	    if (SvTHINKFIRST(sv)) {
-		if (SvREADONLY(sv) && curcop != &compiling) {
-		    if (!SvIMMORTAL(sv))
-			DIE(no_modify);
-		    if (relem <= lastrelem)
-			relem++;
-		    break;
-		}
-		if (SvROK(sv))
-		    sv_unref(sv);
+	    if (SvIMMORTAL(sv)) {
+		if (relem <= lastrelem)
+		    relem++;
+		break;
 	    }
 	    if (relem <= lastrelem) {
 		sv_setsv(sv, *relem);
 		*(relem++) = sv;
 	    }
 	    else
-		sv_setsv(sv, &sv_undef);
+		sv_setsv(sv, &PL_sv_undef);
 	    SvSETMAGIC(sv);
 	    break;
 	}
     }
-    if (delaymagic & ~DM_DELAY) {
-	if (delaymagic & DM_UID) {
+    if (PL_delaymagic & ~DM_DELAY) {
+	if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-	    (void)setresuid(uid,euid,(Uid_t)-1);
+	    (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
-	    (void)setreuid(uid,euid);
+	    (void)setreuid(PL_uid,PL_euid);
 #  else
 #    ifdef HAS_SETRUID
-	    if ((delaymagic & DM_UID) == DM_RUID) {
-		(void)setruid(uid);
-		delaymagic &= ~DM_RUID;
+	    if ((PL_delaymagic & DM_UID) == DM_RUID) {
+		(void)setruid(PL_uid);
+		PL_delaymagic &= ~DM_RUID;
 	    }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
-	    if ((delaymagic & DM_UID) == DM_EUID) {
-		(void)seteuid(uid);
-		delaymagic &= ~DM_EUID;
+	    if ((PL_delaymagic & DM_UID) == DM_EUID) {
+		(void)seteuid(PL_uid);
+		PL_delaymagic &= ~DM_EUID;
 	    }
 #    endif /* HAS_SETEUID */
-	    if (delaymagic & DM_UID) {
-		if (uid != euid)
-		    DIE("No setreuid available");
-		(void)PerlProc_setuid(uid);
+	    if (PL_delaymagic & DM_UID) {
+		if (PL_uid != PL_euid)
+		    DIE(aTHX_ "No setreuid available");
+		(void)PerlProc_setuid(PL_uid);
 	    }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-	    uid = (int)PerlProc_getuid();
-	    euid = (int)PerlProc_geteuid();
+	    PL_uid = (int)PerlProc_getuid();
+	    PL_euid = (int)PerlProc_geteuid();
 	}
-	if (delaymagic & DM_GID) {
+	if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-	    (void)setresgid(gid,egid,(Gid_t)-1);
+	    (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
-	    (void)setregid(gid,egid);
+	    (void)setregid(PL_gid,PL_egid);
 #  else
 #    ifdef HAS_SETRGID
-	    if ((delaymagic & DM_GID) == DM_RGID) {
-		(void)setrgid(gid);
-		delaymagic &= ~DM_RGID;
+	    if ((PL_delaymagic & DM_GID) == DM_RGID) {
+		(void)setrgid(PL_gid);
+		PL_delaymagic &= ~DM_RGID;
 	    }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
-	    if ((delaymagic & DM_GID) == DM_EGID) {
-		(void)setegid(gid);
-		delaymagic &= ~DM_EGID;
+	    if ((PL_delaymagic & DM_GID) == DM_EGID) {
+		(void)setegid(PL_gid);
+		PL_delaymagic &= ~DM_EGID;
 	    }
 #    endif /* HAS_SETEGID */
-	    if (delaymagic & DM_GID) {
-		if (gid != egid)
-		    DIE("No setregid available");
-		(void)PerlProc_setgid(gid);
+	    if (PL_delaymagic & DM_GID) {
+		if (PL_gid != PL_egid)
+		    DIE(aTHX_ "No setregid available");
+		(void)PerlProc_setgid(PL_gid);
 	    }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-	    gid = (int)PerlProc_getgid();
-	    egid = (int)PerlProc_getegid();
+	    PL_gid = (int)PerlProc_getgid();
+	    PL_egid = (int)PerlProc_getegid();
 	}
-	tainting |= (uid && (euid != uid || egid != gid));
+	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
     }
-    delaymagic = 0;
+    PL_delaymagic = 0;
 
     gimme = GIMME_V;
     if (gimme == G_VOID)
@@ -775,11 +812,21 @@ PP(pp_aassign)
 	    SP = firstrelem + (lastlelem - firstlelem);
 	lelem = firstlelem + (relem - firstrelem);
 	while (relem <= SP)
-	    *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef;
+	    *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
     }
     RETURN;
 }
 
+PP(pp_qr)
+{
+    djSP;
+    register PMOP *pm = cPMOP;
+    SV *rv = sv_newmortal();
+    SV *sv = newSVrv(rv, "Regexp");
+    sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
+    RETURNX(PUSHs(rv));
+}
+
 PP(pp_match)
 {
     djSP; dTARG;
@@ -788,18 +835,18 @@ PP(pp_match)
     register char *s;
     char *strend;
     I32 global;
-    I32 safebase;
-    char *truebase;
+    I32 r_flags = REXEC_CHECKED;
+    char *truebase;			/* Start of string  */
     register REGEXP *rx = pm->op_pmregexp;
     bool rxtainted;
     I32 gimme = GIMME;
     STRLEN len;
     I32 minmatch = 0;
-    I32 oldsave = savestack_ix;
+    I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
-    SV *screamer;
+    I32 had_zerolen = 0;
 
-    if (op->op_flags & OPf_STACKED)
+    if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
     else {
 	TARG = DEFSV;
@@ -809,9 +856,9 @@ PP(pp_match)
     s = SvPV(TARG, len);
     strend = s + len;
     if (!s)
-	DIE("panic: do_match");
+	DIE(aTHX_ "panic: do_match");
     rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
-		 (tainted && (pm->op_pmflags & PMf_RETAINT)));
+		 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
     if (pm->op_pmdynflags & PMdf_USED) {
@@ -821,94 +868,65 @@ PP(pp_match)
 	RETPUSHNO;
     }
 
-    if (!rx->prelen && curpm) {
-	pm = curpm;
+    if (!rx->prelen && PL_curpm) {
+	pm = PL_curpm;
 	rx = pm->op_pmregexp;
     }
     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;
+	rx->startp[0] = -1;
 	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] = mg->mg_len; 
+		else if (rx->reganch & ROPT_ANCH_GPOS) {
+		    r_flags |= REXEC_IGNOREPOS;
+		    rx->endp[0] = rx->startp[0] = mg->mg_len; 
+		}
 		minmatch = (mg->mg_flags & MGf_MINMATCH);
 		update_minmatch = 0;
 	    }
 	}
     }
-    if (!rx->nparens && !global)
-	gimme = G_SCALAR;			/* accidental array context? */
-    safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
-		&& !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)) 
+	r_flags |= REXEC_SCREAM;
+
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
-	SAVEINT(multiline);
-	multiline = pm->op_pmflags & PMf_MULTILINE;
+	SAVEINT(PL_multiline);
+	PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
 
 play_it_again:
-    if (global && rx->startp[0]) {
-	t = s = rx->endp[0];
+    if (global && rx->startp[0] != -1) {
+	t = s = rx->endp[0] + truebase;
 	if ((s + rx->minlen) > strend)
 	    goto nope;
 	if (update_minmatch++)
-	    minmatch = (s == rx->startp[0]);
-    }
-    if (rx->check_substr) {
-	if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
-	    if ( screamer ) {
-		I32 p = -1;
-		
-		if (screamfirst[BmRARE(rx->check_substr)] < 0)
-		    goto nope;
-		else if (!(s = screaminstr(TARG, rx->check_substr, 
-					   rx->check_offset_min, 0, &p, 0)))
-		    goto nope;
-		else if ((rx->reganch & ROPT_CHECK_ALL)
-			 && !sawampersand && !SvTAIL(rx->check_substr))
-		    goto yup;
-	    }
-	    else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
-				     (unsigned char*)strend, 
-				     rx->check_substr, 0)))
-		goto nope;
-	    else if ((rx->reganch & ROPT_CHECK_ALL) && !sawampersand)
-		goto yup;
-	    if (s && rx->check_offset_max < s - t) {
-		++BmUSEFUL(rx->check_substr);
-		s -= rx->check_offset_max;
-	    }
-	    else
-		s = t;
-	}
-	/* Now checkstring is fixed, i.e. at fixed offset from the
-	   beginning of match, and the match is anchored at s. */
-	else if (!multiline) {	/* Anchored near beginning of string. */
-	    I32 slen;
-	    if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
-		|| ((slen = SvCUR(rx->check_substr)) > 1
-		    && memNE(SvPVX(rx->check_substr), 
-			     s + rx->check_offset_min, slen)))
-		goto nope;
-	}
-	if (!rx->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 (regexec_flags(rx, s, strend, truebase, minmatch,
-		      screamer, NULL, safebase))
+	    minmatch = had_zerolen;
+    }
+    if (rx->reganch & RE_USE_INTUIT) {
+	s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
+
+	if (!s)
+	    goto nope;
+	if ( (rx->reganch & ROPT_CHECK_ALL)
+	     && !PL_sawampersand 
+	     && ((rx->reganch & ROPT_NOSCAN)
+		 || !((rx->reganch & RE_INTUIT_TAIL)
+		      && (r_flags & REXEC_SCREAM))))
+	    goto yup;
+    }
+    if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
     {
-	curpm = pm;
+	PL_curpm = pm;
 	if (pm->op_pmflags & PMf_ONCE)
 	    pm->op_pmdynflags |= PMdf_USED;
 	goto gotcha;
@@ -935,19 +953,21 @@ play_it_again:
 	for (i = !i; i <= iters; i++) {
 	    PUSHs(sv_newmortal());
 	    /*SUPPRESS 560*/
-	    if ((s = rx->startp[i]) && rx->endp[i] ) {
-		len = rx->endp[i] - s;
+	    if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
+		len = rx->endp[i] - rx->startp[i];
+		s = rx->startp[i] + truebase;
 		sv_setpvn(*SP, s, len);
 	    }
 	}
 	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] != -1
+			   && rx->startp[0] == rx->endp[0]);
 	    PUTBACK;			/* EVAL blocks may use stack */
+	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	    goto play_it_again;
 	}
+	else if (!iters)
+	    XPUSHs(&PL_sv_yes);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
@@ -960,8 +980,8 @@ play_it_again:
 		sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
 		mg = mg_find(TARG, 'g');
 	    }
-	    if (rx->startp[0]) {
-		mg->mg_len = rx->endp[0] - rx->subbeg;
+	    if (rx->startp[0] != -1) {
+		mg->mg_len = rx->endp[0];
 		if (rx->startp[0] == rx->endp[0])
 		    mg->mg_flags |= MGf_MINMATCH;
 		else
@@ -972,39 +992,41 @@ play_it_again:
 	RETPUSHYES;
     }
 
-yup:					/* Confirmed by check_substr */
+yup:					/* Confirmed by INTUIT */
     if (rxtainted)
 	RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
-    ++BmUSEFUL(rx->check_substr);
-    curpm = pm;
+    PL_curpm = pm;
     if (pm->op_pmflags & PMf_ONCE)
 	pm->op_pmdynflags |= PMdf_USED;
-    Safefree(rx->subbase);
-    rx->subbase = Nullch;
+    if (RX_MATCH_COPIED(rx))
+	Safefree(rx->subbeg);
+    RX_MATCH_COPIED_off(rx);
+    rx->subbeg = Nullch;
     if (global) {
 	rx->subbeg = truebase;
-	rx->subend = strend;
-	rx->startp[0] = s;
-	rx->endp[0] = s + SvCUR(rx->check_substr);
+	rx->startp[0] = s - truebase;
+	rx->endp[0] = s - truebase + rx->minlen;
+	rx->sublen = strend - truebase;
 	goto gotcha;
-    }
-    if (sawampersand) {
-	char *tmps;
+    } 
+    if (PL_sawampersand) {
+	I32 off;
 
-	tmps = rx->subbase = savepvn(t, strend-t);
-	rx->subbeg = tmps;
-	rx->subend = tmps + (strend-t);
-	tmps = rx->startp[0] = tmps + (s - t);
-	rx->endp[0] = tmps + SvCUR(rx->check_substr);
+	rx->subbeg = savepvn(t, strend - t);
+	rx->sublen = strend - t;
+	RX_MATCH_COPIED_on(rx);
+	off = rx->startp[0] = s - t;
+	rx->endp[0] = off + rx->minlen;
+    }
+    else {			/* startp/endp are used by @- @+. */
+	rx->startp[0] = s - truebase;
+	rx->endp[0] = s - truebase + rx->minlen;
     }
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
 nope:
-    if (rx->check_substr)
-	++BmUSEFUL(rx->check_substr);
-
 ret_no:
     if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
@@ -1020,24 +1042,24 @@ ret_no:
 }
 
 OP *
-do_readline(void)
+Perl_do_readline(pTHX)
 {
     dSP; dTARGETSTACKED;
     register SV *sv;
     STRLEN tmplen = 0;
     STRLEN offset;
     PerlIO *fp;
-    register IO *io = GvIO(last_in_gv);
-    register I32 type = op->op_type;
+    register IO *io = GvIO(PL_last_in_gv);
+    register I32 type = PL_op->op_type;
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (SvRMAGICAL(last_in_gv) && (mg = mg_find((SV*)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);
+	call_method("READLINE", gimme);
 	LEAVE;
 	SPAGAIN;
 	if (gimme == G_SCALAR)
@@ -1052,17 +1074,17 @@ do_readline(void)
 		if (IoFLAGS(io) & IOf_START) {
 		    IoFLAGS(io) &= ~IOf_START;
 		    IoLINES(io) = 0;
-		    if (av_len(GvAVn(last_in_gv)) < 0) {
-			do_open(last_in_gv,"-",1,FALSE,0,0,Nullfp);
-			sv_setpvn(GvSV(last_in_gv), "-", 1);
-			SvSETMAGIC(GvSV(last_in_gv));
+		    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
+			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);
 			goto have_fp;
 		    }
 		}
-		fp = nextargv(last_in_gv);
+		fp = nextargv(PL_last_in_gv);
 		if (!fp) { /* Note: fp != IoIFP(io) */
-		    (void)do_close(last_in_gv, FALSE); /* now it does*/
+		    (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
 		    IoFLAGS(io) |= IOf_START;
 		}
 	    }
@@ -1172,7 +1194,7 @@ do_readline(void)
 #endif /* !OS2 */
 #else /* !DOSISH */
 #if defined(CSH)
-		sv_setpvn(tmpcmd, cshname, cshlen);
+		sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
 		sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
 		sv_catsv(tmpcmd, tmpglob);
 		sv_catpv(tmpcmd, "' 2>/dev/null |");
@@ -1186,8 +1208,8 @@ do_readline(void)
 #endif
 #endif /* !CSH */
 #endif /* !DOSISH */
-		(void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
-			      FALSE, 0, 0, Nullfp);
+		(void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+			      FALSE, O_RDONLY, 0, Nullfp);
 		fp = IoIFP(io);
 #endif /* !VMS */
 		LEAVE;
@@ -1195,10 +1217,30 @@ do_readline(void)
 	}
 	else if (type == OP_GLOB)
 	    SP--;
+	else if (ckWARN(WARN_IO)	/* stdout/stderr or other write fh */
+		 && (IoTYPE(io) == '>' || fp == PerlIO_stdout()
+		     || fp == PerlIO_stderr()))
+	{
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, PL_last_in_gv, Nullch);
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+			SvPV_nolen(sv));
+	}
     }
     if (!fp) {
-	if (dowarn && io && !(IoFLAGS(io) & IOf_START))
-	    warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
+	if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+	    if (type == OP_GLOB)
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "glob failed (can't start child: %s)",
+			    Strerror(errno));
+	    else {
+		SV* sv = sv_newmortal();
+		gv_efullname3(sv, PL_last_in_gv, Nullch);
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "Read on closed filehandle %s",
+			    SvPV_nolen(sv));
+	    }
+	}
 	if (gimme == G_SCALAR) {
 	    (void)SvOK_off(TARG);
 	    PUSHTARG;
@@ -1223,19 +1265,33 @@ 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(last_in_gv);
+		fp = nextargv(PL_last_in_gv);
 		if (fp)
 		    continue;
-		(void)do_close(last_in_gv, FALSE);
+		(void)do_close(PL_last_in_gv, FALSE);
 		IoFLAGS(io) |= IOf_START;
 	    }
 	    else if (type == OP_GLOB) {
-		if (do_close(last_in_gv, FALSE) & ~0xFF)
-		    warn("internal error: glob failed");
+		if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
+		    Perl_warner(aTHX_ 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);
@@ -1254,9 +1310,9 @@ do_readline(void)
 	if (type == OP_GLOB) {
 	    char *tmps;
 
-	    if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
+	    if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
 		tmps = SvEND(sv) - 1;
-		if (*tmps == *SvPVX(rs)) {
+		if (*tmps == *SvPVX(PL_rs)) {
 		    *tmps = '\0';
 		    SvCUR(sv)--;
 		}
@@ -1265,7 +1321,7 @@ do_readline(void)
 		if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
 		    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
 			break;
-	    if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) {
+	    if (*tmps && PerlLIO_lstat(SvPVX(sv), &PL_statbuf) < 0) {
 		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
 		continue;
 	    }
@@ -1294,7 +1350,7 @@ PP(pp_enter)
 {
     djSP;
     register PERL_CONTEXT *cx;
-    I32 gimme = OP_GIMME(op, -1);
+    I32 gimme = OP_GIMME(PL_op, -1);
 
     if (gimme == -1) {
 	if (cxstack_ix >= 0)
@@ -1318,8 +1374,8 @@ PP(pp_helem)
     SV **svp;
     SV *keysv = POPs;
     HV *hv = (HV*)POPs;
-    U32 lval = op->op_flags & OPf_MOD;
-    U32 defer = op->op_private & OPpLVAL_DEFER;
+    U32 lval = PL_op->op_flags & OPf_MOD;
+    U32 defer = PL_op->op_private & OPpLVAL_DEFER;
     SV *sv;
 
     if (SvTYPE(hv) == SVt_PVHV) {
@@ -1327,17 +1383,21 @@ PP(pp_helem)
 	svp = he ? &HeVAL(he) : 0;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
+	if (PL_op->op_private & OPpLVAL_INTRO)
+	    DIE(aTHX_ "Can't localize pseudo-hash element");
 	svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
     }
     else {
 	RETPUSHUNDEF;
     }
     if (lval) {
-	if (!svp || *svp == &sv_undef) {
+	if (!svp || *svp == &PL_sv_undef) {
 	    SV* lv;
 	    SV* key2;
-	    if (!defer)
-		DIE(no_helem, SvPV(keysv, na));
+	    if (!defer) {
+		STRLEN n_a;
+		DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+	    }
 	    lv = sv_newmortal();
 	    sv_upgrade(lv, SVt_PVLV);
 	    LvTYPE(lv) = 'y';
@@ -1348,16 +1408,16 @@ PP(pp_helem)
 	    PUSHs(lv);
 	    RETURN;
 	}
-	if (op->op_private & OPpLVAL_INTRO) {
+	if (PL_op->op_private & OPpLVAL_INTRO) {
 	    if (HvNAME(hv) && isGV(*svp))
-		save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
+		save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
 	    else
 		save_helem(hv, keysv, svp);
 	}
-	else if (op->op_private & OPpDEREF)
-	    vivify_ref(*svp, op->op_private & OPpDEREF);
+	else if (PL_op->op_private & OPpDEREF)
+	    vivify_ref(*svp, PL_op->op_private & OPpDEREF);
     }
-    sv = (svp ? *svp : &sv_undef);
+    sv = (svp ? *svp : &PL_sv_undef);
     /* This makes C<local $tied{foo} = $tied{foo}> possible.
      * Pushing the magical RHS on to the stack is useless, since
      * that magic is soon destined to be misled by the local(),
@@ -1379,14 +1439,14 @@ PP(pp_leave)
     PMOP *newpm;
     I32 gimme;
 
-    if (op->op_flags & OPf_SPECIAL) {
+    if (PL_op->op_flags & OPf_SPECIAL) {
 	cx = &cxstack[cxstack_ix];
-	cx->blk_oldpm = curpm;	/* fake block should preserve $1 et al */
+	cx->blk_oldpm = PL_curpm;	/* fake block should preserve $1 et al */
     }
 
     POPBLOCK(cx,newpm);
 
-    gimme = OP_GIMME(op, -1);
+    gimme = OP_GIMME(PL_op, -1);
     if (gimme == -1) {
 	if (cxstack_ix >= 0)
 	    gimme = cxstack[cxstack_ix].blk_gimme;
@@ -1406,7 +1466,7 @@ PP(pp_leave)
 		*MARK = sv_mortalcopy(TOPs);
 	else {
 	    MEXTEND(mark,0);
-	    *MARK = &sv_undef;
+	    *MARK = &PL_sv_undef;
 	}
 	SP = MARK;
     }
@@ -1419,7 +1479,7 @@ PP(pp_leave)
 	    }
 	}
     }
-    curpm = newpm;	/* Don't pop $1 et al till now */
+    PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
     LEAVE;
 
@@ -1435,8 +1495,8 @@ PP(pp_iter)
 
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
-    if (cx->cx_type != CXt_LOOP)
-	DIE("panic: pp_iter");
+    if (CxTYPE(cx) != CXt_LOOP)
+	DIE(aTHX_ "panic: pp_iter");
 
     av = cx->blk_loop.iterary;
     if (SvTYPE(av) != SVt_PVAV) {
@@ -1447,7 +1507,22 @@ PP(pp_iter)
 	    STRLEN maxlen;
 	    char *max = SvPV((SV*)av, maxlen);
 	    if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
-		sv_setsv(*cx->blk_loop.itervar, cur);
+#ifndef USE_THREADS			  /* don't risk potential race */
+		if (SvREFCNT(*cx->blk_loop.itervar) == 1
+		    && !SvMAGICAL(*cx->blk_loop.itervar))
+		{
+		    /* safe to reuse old SV */
+		    sv_setsv(*cx->blk_loop.itervar, cur);
+		}
+		else 
+#endif
+		{
+		    /* we need a fresh SV every time so that loop body sees a
+		     * completely new SV for closures/references to work as
+		     * they used to */
+		    SvREFCNT_dec(*cx->blk_loop.itervar);
+		    *cx->blk_loop.itervar = newSVsv(cur);
+		}
 		if (strEQ(SvPVX(cur), max))
 		    sv_setiv(cur, 0); /* terminate next time */
 		else
@@ -1459,12 +1534,28 @@ PP(pp_iter)
 	/* integer increment */
 	if (cx->blk_loop.iterix > cx->blk_loop.itermax)
 	    RETPUSHNO;
-	sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+
+#ifndef USE_THREADS			  /* don't risk potential race */
+	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++);
+	}
+	else 
+#endif
+	{
+	    /* we need a fresh SV every time so that loop body sees a
+	     * completely new SV for closures/references to work as they
+	     * used to */
+	    SvREFCNT_dec(*cx->blk_loop.itervar);
+	    *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++);
+	}
 	RETPUSHYES;
     }
 
     /* iterate array */
-    if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
+    if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
 	RETPUSHNO;
 
     SvREFCNT_dec(*cx->blk_loop.itervar);
@@ -1474,8 +1565,8 @@ PP(pp_iter)
 	    : AvARRAY(av)[++cx->blk_loop.iterix])
 	SvTEMP_off(sv);
     else
-	sv = &sv_undef;
-    if (av != curstack && SvIMMORTAL(sv)) {
+	sv = &PL_sv_undef;
+    if (av != PL_curstack && SvIMMORTAL(sv)) {
 	SV *lv = cx->blk_loop.iterlval;
 	if (lv && SvREFCNT(lv) > 1) {
 	    SvREFCNT_dec(lv);
@@ -1517,17 +1608,16 @@ 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 = savestack_ix;
+    I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
-    SV *screamer;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
-    if (op->op_flags & OPf_STACKED)
+    if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
     else {
 	TARG = DEFSV;
@@ -1536,76 +1626,53 @@ PP(pp_subst)
     if (SvREADONLY(TARG)
 	|| (SvTYPE(TARG) > SVt_PVLV
 	    && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
-	croak(no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
     PUTBACK;
 
     s = SvPV(TARG, len);
     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
 	force_on_match = 1;
     rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
-		 (tainted && (pm->op_pmflags & PMf_RETAINT)));
-    if (tainted)
+		 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
+    if (PL_tainted)
 	rxtainted |= 2;
     TAINT_NOT;
 
   force_it:
     if (!pm || !s)
-	DIE("panic: do_subst");
+	DIE(aTHX_ "panic: do_subst");
 
     strend = s + len;
-    maxiters = (strend - s) + 10;
+    maxiters = 2*(strend - s) + 10;	/* We can match twice at each 
+					   position, once with zero-length,
+					   second time with non-zero. */
 
-    if (!rx->prelen && curpm) {
-	pm = curpm;
+    if (!rx->prelen && PL_curpm) {
+	pm = PL_curpm;
 	rx = pm->op_pmregexp;
     }
-    screamer = ( (SvSCREAM(TARG) && rx->check_substr
-		  && SvTYPE(rx->check_substr) == SVt_PVBM
-		  && SvVALID(rx->check_substr)) 
-		? TARG : Nullsv);
-    safebase = (!rx->nparens && !sawampersand) ? 0 : REXEC_COPY_STR;
+    r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+		? REXEC_COPY_STR : 0;
+    if (SvSCREAM(TARG))
+	r_flags |= REXEC_SCREAM;
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
-	SAVEINT(multiline);
-	multiline = pm->op_pmflags & PMf_MULTILINE;
+	SAVEINT(PL_multiline);
+	PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
     orig = m = s;
-    if (rx->check_substr) {
-	if (!(rx->reganch & ROPT_NOSCAN)) { /* It floats. */
-	    if (screamer) {
-		I32 p = -1;
-		
-		if (screamfirst[BmRARE(rx->check_substr)] < 0)
-		    goto nope;
-		else if (!(s = screaminstr(TARG, rx->check_substr, rx->check_offset_min, 0, &p, 0)))
-		    goto nope;
-	    }
-	    else if (!(s = fbm_instr((unsigned char*)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;
-	    }
-	    else
-		s = m;
-	}
-	/* Now checkstring is fixed, i.e. at fixed offset from the
-	   beginning of match, and the match is anchored at s. */
-	else if (!multiline) { /* Anchored at beginning of string. */
-	    I32 slen;
-	    if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
-		|| ((slen = SvCUR(rx->check_substr)) > 1
-		    && memNE(SvPVX(rx->check_substr), 
-			     s + rx->check_offset_min, slen)))
-		goto nope;
-	}
-	if (!rx->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 (rx->reganch & RE_USE_INTUIT) {
+	s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
+
+	if (!s)
+	    goto nope;
+	/* How to do it in subst? */
+/*	if ( (rx->reganch & ROPT_CHECK_ALL)
+	     && !PL_sawampersand 
+	     && ((rx->reganch & ROPT_NOSCAN)
+		 || !((rx->reganch & RE_INTUIT_TAIL)
+		      && (r_flags & REXEC_SCREAM))))
+	    goto yup;
+*/
     }
 
     /* only replace once? */
@@ -1615,11 +1682,13 @@ 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 (!regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+	if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
+			 r_flags | REXEC_CHECKED))
+	{
 	    SPAGAIN;
-	    PUSHs(&sv_no);
+	    PUSHs(&PL_sv_no);
 	    LEAVE_SCOPE(oldsave);
 	    RETURN;
 	}
@@ -1629,17 +1698,12 @@ PP(pp_subst)
 	    goto force_it;
 	}
 	d = s;
-	curpm = pm;
+	PL_curpm = pm;
 	SvSCREAM_off(TARG);	/* disable possible screamer */
 	if (once) {
 	    rxtainted |= RX_MATCH_TAINTED(rx);
-	    if (rx->subbase) {
-		m = orig + (rx->startp[0] - rx->subbase);
-		d = orig + (rx->endp[0] - rx->subbase);
-	    } else {
-		m = rx->startp[0];
-		d = rx->endp[0];
-	    }
+	    m = orig + rx->startp[0];
+	    d = orig + rx->endp[0];
 	    s = orig;
 	    if (m - s > strend - d) {  /* faster to shorten from end */
 		if (clen) {
@@ -1675,14 +1739,14 @@ PP(pp_subst)
 	    }
 	    TAINT_IF(rxtainted & 1);
 	    SPAGAIN;
-	    PUSHs(&sv_yes);
+	    PUSHs(&PL_sv_yes);
 	}
 	else {
 	    do {
 		if (iters++ > maxiters)
-		    DIE("Substitution loop");
+		    DIE(aTHX_ "Substitution loop");
 		rxtainted |= RX_MATCH_TAINTED(rx);
-		m = rx->startp[0];
+		m = rx->startp[0] + orig;
 		/*SUPPRESS 560*/
 		if (i = m - s) {
 		    if (s != d)
@@ -1693,9 +1757,11 @@ PP(pp_subst)
 		    Copy(c, d, clen, char);
 		    d += clen;
 		}
-		s = rx->endp[0];
-	    } while (regexec_flags(rx, s, strend, orig, s == m,
-			      Nullsv, NULL, 0)); /* don't match same null twice */
+		s = rx->endp[0] + orig;
+	    } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
+				 TARG, NULL,
+				 /* don't match same null twice */
+				 REXEC_NOT_FIRST|REXEC_IGNOREPOS));
 	    if (s != d) {
 		i = strend - s;
 		SvCUR_set(TARG, d - SvPVX(TARG) + i);
@@ -1717,7 +1783,9 @@ PP(pp_subst)
 	RETURN;
     }
 
-    if (regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+    if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
+		    r_flags | REXEC_CHECKED))
+    {
 	if (force_on_match) {
 	    force_on_match = 0;
 	    s = SvPV_force(TARG, len);
@@ -1726,32 +1794,33 @@ PP(pp_subst)
 	rxtainted |= RX_MATCH_TAINTED(rx);
 	dstr = NEWSV(25, len);
 	sv_setpvn(dstr, m, s-m);
-	curpm = pm;
+	PL_curpm = pm;
 	if (!c) {
 	    register PERL_CONTEXT *cx;
 	    SPAGAIN;
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplroot);
 	}
+	r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	do {
 	    if (iters++ > maxiters)
-		DIE("Substitution loop");
+		DIE(aTHX_ "Substitution loop");
 	    rxtainted |= RX_MATCH_TAINTED(rx);
-	    if (rx->subbase && rx->subbase != orig) {
+	    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
 		m = s;
 		s = orig;
-		orig = rx->subbase;
+		orig = rx->subbeg;
 		s = orig + (m - s);
 		strend = s + (strend - m);
 	    }
-	    m = rx->startp[0];
+	    m = rx->startp[0] + orig;
 	    sv_catpvn(dstr, s, m-s);
-	    s = rx->endp[0];
+	    s = rx->endp[0] + orig;
 	    if (clen)
 		sv_catpvn(dstr, c, clen);
 	    if (once)
 		break;
-	} while (regexec_flags(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
+	} while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags));
 	sv_catpvn(dstr, s, strend - s);
 
 	(void)SvOOK_off(TARG);
@@ -1776,11 +1845,9 @@ PP(pp_subst)
     goto ret_no;
 
 nope:
-    ++BmUSEFUL(rx->check_substr);
-
 ret_no:         
     SPAGAIN;
-    PUSHs(&sv_no);
+    PUSHs(&PL_sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
 }
@@ -1790,20 +1857,20 @@ PP(pp_grepwhile)
     djSP;
 
     if (SvTRUEx(POPs))
-	stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
-    ++*markstack_ptr;
+	PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
+    ++*PL_markstack_ptr;
     LEAVE;					/* exit inner scope */
 
     /* All done yet? */
-    if (stack_base + *markstack_ptr > SP) {
+    if (PL_stack_base + *PL_markstack_ptr > SP) {
 	I32 items;
 	I32 gimme = GIMME_V;
 
 	LEAVE;					/* exit outer scope */
 	(void)POPMARK;				/* pop src */
-	items = --*markstack_ptr - markstack_ptr[-1];
+	items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
 	(void)POPMARK;				/* pop dst */
-	SP = stack_base + POPMARK;		/* pop original mark */
+	SP = PL_stack_base + POPMARK;		/* pop original mark */
 	if (gimme == G_SCALAR) {
 	    dTARGET;
 	    XPUSHi(items);
@@ -1816,9 +1883,9 @@ PP(pp_grepwhile)
 	SV *src;
 
 	ENTER;					/* enter inner scope */
-	SAVESPTR(curpm);
+	SAVESPTR(PL_curpm);
 
-	src = stack_base[*markstack_ptr];
+	src = PL_stack_base[*PL_markstack_ptr];
 	SvTEMP_off(src);
 	DEFSV = src;
 
@@ -1856,7 +1923,7 @@ PP(pp_leavesub)
 		*MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
 	} else {
 	    MEXTEND(MARK, 0);
-	    *MARK = &sv_undef;
+	    *MARK = &PL_sv_undef;
 	}
 	SP = MARK;
     }
@@ -1871,17 +1938,17 @@ PP(pp_leavesub)
     PUTBACK;
     
     POPSUB2();		/* Stack values are safe: release CV and @_ ... */
-    curpm = newpm;	/* ... and pop $1 et al */
+    PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
     return pop_return();
 }
 
 STATIC CV *
-get_db_sub(SV **svp, CV *cv)
+S_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     dTHR;
-    SV *dbsv = GvSV(DBsub);
+    SV *dbsv = GvSV(PL_DBsub);
 
     if (!PERLDB_SUB_NN) {
 	GV *gv = CvGV(cv);
@@ -1908,8 +1975,8 @@ get_db_sub(SV **svp, CV *cv)
     }
 
     if (CvXSUB(cv))
-	curcopdb = curcop;
-    cv = GvCV(DBsub);
+	PL_curcopdb = PL_curcop;
+    cv = GvCV(PL_DBsub);
     return cv;
 }
 
@@ -1921,18 +1988,19 @@ PP(pp_entersub)
     register CV *cv;
     register PERL_CONTEXT *cx;
     I32 gimme;
-    bool hasargs = (op->op_flags & OPf_STACKED) != 0;
+    bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
 
     if (!sv)
-	DIE("Not a CODE reference");
+	DIE(aTHX_ "Not a CODE reference");
     switch (SvTYPE(sv)) {
     default:
 	if (!SvROK(sv)) {
 	    char *sym;
+	    STRLEN n_a;
 
-	    if (sv == &sv_yes) {		/* unfound import, ignore */
+	    if (sv == &PL_sv_yes) {		/* unfound import, ignore */
 		if (hasargs)
-		    SP = stack_base + POPMARK;
+		    SP = PL_stack_base + POPMARK;
 		RETURN;
 	    }
 	    if (SvGMAGICAL(sv)) {
@@ -1940,27 +2008,36 @@ PP(pp_entersub)
 		sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
 	    }
 	    else
-		sym = SvPV(sv, na);
+		sym = SvPV(sv, n_a);
 	    if (!sym)
-		DIE(no_usym, "a subroutine");
-	    if (op->op_private & HINT_STRICT_REFS)
-		DIE(no_symref, sym, "a subroutine");
-	    cv = perl_get_cv(sym, TRUE);
+		DIE(aTHX_ PL_no_usym, "a subroutine");
+	    if (PL_op->op_private & HINT_STRICT_REFS)
+		DIE(aTHX_ PL_no_symref, sym, "a subroutine");
+	    cv = 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;
 	/* FALL THROUGH */
     case SVt_PVHV:
     case SVt_PVAV:
-	DIE("Not a CODE reference");
+	DIE(aTHX_ "Not a CODE reference");
     case SVt_PVCV:
 	cv = (CV*)sv;
 	break;
     case SVt_PVGV:
 	if (!(cv = GvCVu((GV*)sv)))
-	    cv = sv_2cv(sv, &stash, &gv, TRUE);
+	    cv = sv_2cv(sv, &stash, &gv, FALSE);
+	if (!cv) {
+	    ENTER;
+	    SAVETMPS;
+	    goto try_autoload;
+	}
 	break;
     }
 
@@ -1968,39 +2045,44 @@ PP(pp_entersub)
     SAVETMPS;
 
   retry:
-    if (!cv)
-	DIE("Not a CODE reference");
-
     if (!CvROOT(cv) && !CvXSUB(cv)) {
 	GV* autogv;
 	SV* sub_name;
 
 	/* anonymous or undef'd function leaves us no recourse */
 	if (CvANON(cv) || !(gv = CvGV(cv)))
-	    DIE("Undefined subroutine called");
+	    DIE(aTHX_ "Undefined subroutine called");
+
 	/* autoloaded stub? */
 	if (cv != GvCV(gv)) {
 	    cv = GvCV(gv);
-	    goto retry;
 	}
 	/* should call AUTOLOAD now? */
-	if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+	else {
+try_autoload:
+	    if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
 				   FALSE)))
-	{
-	    cv = GvCV(autogv);
-	    goto retry;
+	    {
+		cv = GvCV(autogv);
+	    }
+	    /* sorry */
+	    else {
+		sub_name = sv_newmortal();
+		gv_efullname3(sub_name, gv, Nullch);
+		DIE(aTHX_ "Undefined subroutine &%s called", SvPVX(sub_name));
+	    }
 	}
-	/* sorry */
-	sub_name = sv_newmortal();
-	gv_efullname3(sub_name, gv, Nullch);
-	DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+	if (!cv)
+	    DIE(aTHX_ "Not a CODE reference");
+	goto retry;
     }
 
     gimme = GIMME_V;
-    if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv))
+    if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
 	cv = get_db_sub(&sv, cv);
-    if (!cv)
-	DIE("No DBsub routine");
+	if (!cv)
+	    DIE(aTHX_ "No DBsub routine");
+    }
 
 #ifdef USE_THREADS
     /*
@@ -2014,11 +2096,16 @@ PP(pp_entersub)
     if (CvFLAGS(cv) & CVf_LOCKED) {
 	MAGIC *mg;	
 	if (CvFLAGS(cv) & CVf_METHOD) {
-	    if (SP > stack_base + TOPMARK)
-		sv = *(stack_base + TOPMARK + 1);
+	    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));
+		    Perl_croak(aTHX_ "no argument for locked method call");
+		}
 	    }
 	    if (SvROK(sv))
 		sv = SvRV(sv);
@@ -2040,11 +2127,10 @@ 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);
+	    SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
 	}
 	MUTEX_LOCK(CvMUTEXP(cv));
     }
@@ -2078,13 +2164,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 (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;
@@ -2098,7 +2183,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)"));
@@ -2107,7 +2192,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))));
 		/*
@@ -2124,7 +2209,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);
@@ -2133,8 +2218,9 @@ PP(pp_entersub)
 #endif /* USE_THREADS */
 
     if (CvXSUB(cv)) {
+#ifdef PERL_XSUB_OLDSTYLE
 	if (CvOLDSTYLE(cv)) {
-	    I32 (*fp3)_((int,int,int));
+	    I32 (*fp3)(int,int,int);
 	    dMARK;
 	    register I32 items = SP - MARK;
 					/* We dont worry to copy from @_. */
@@ -2142,14 +2228,16 @@ PP(pp_entersub)
 		SP[1] = SP[0];
 		SP--;
 	    }
-	    stack_sp = mark + 1;
-	    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
+	    PL_stack_sp = mark + 1;
+	    fp3 = (I32(*)(int,int,int)))CvXSUB(cv;
 	    items = (*fp3)(CvXSUBANY(cv).any_i32, 
-			   MARK - stack_base + 1,
+			   MARK - PL_stack_base + 1,
 			   items);
-	    stack_sp = stack_base + items;
+	    PL_stack_sp = PL_stack_base + items;
 	}
-	else {
+	else
+#endif /* PERL_XSUB_OLDSTYLE */
+	{
 	    I32 markix = TOPMARK;
 
 	    PUTBACK;
@@ -2161,9 +2249,9 @@ PP(pp_entersub)
 		AV* av;
 		I32 items;
 #ifdef USE_THREADS
-		av = (AV*)curpad[0];
+		av = (AV*)PL_curpad[0];
 #else
-		av = GvAV(defgv);
+		av = GvAV(PL_defgv);
 #endif /* USE_THREADS */		
 		items = AvFILLp(av) + 1;   /* @_ is not tieable */
 
@@ -2175,23 +2263,22 @@ PP(pp_entersub)
 		    PUTBACK ;		    
 		}
 	    }
-	    if (curcopdb) {		/* We assume that the first
-					   XSUB in &DB::sub is the
-					   called one. */
-		SAVESPTR(curcop);
-		curcop = curcopdb;
-		curcopdb = NULL;
+	    /* We assume first XSUB in &DB::sub is the called one. */
+	    if (PL_curcopdb) {
+		SAVESPTR(PL_curcop);
+		PL_curcop = PL_curcopdb;
+		PL_curcopdb = NULL;
 	    }
 	    /* Do we need to open block here? XXXX */
-	    (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+	    (void)(*CvXSUB(cv))(aTHXo_ cv);
 
 	    /* Enforce some sanity in scalar context. */
-	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
-		if (markix > stack_sp - stack_base)
-		    *(stack_base + markix) = &sv_undef;
+	    if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
+		if (markix > PL_stack_sp - PL_stack_base)
+		    *(PL_stack_base + markix) = &PL_sv_undef;
 		else
-		    *(stack_base + markix) = *stack_sp;
-		stack_sp = stack_base + markix;
+		    *(PL_stack_base + markix) = *PL_stack_sp;
+		PL_stack_sp = PL_stack_base + markix;
 	    }
 	}
 	LEAVE;
@@ -2202,16 +2289,18 @@ PP(pp_entersub)
 	register I32 items = SP - MARK;
 	AV* padlist = CvPADLIST(cv);
 	SV** svp = AvARRAY(padlist);
-	push_return(op->op_next);
+	push_return(PL_op->op_next);
 	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 && dowarn 
-		  && !(PERLDB_SUB && cv == GvCV(DBsub)))
-		sub_crush_depth(cv);
 	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
@@ -2219,7 +2308,7 @@ PP(pp_entersub)
 		I32 ix = AvFILLp((AV*)svp[1]);
 		svp = AvARRAY(svp[0]);
 		for ( ;ix > 0; ix--) {
-		    if (svp[ix] != &sv_undef) {
+		    if (svp[ix] != &PL_sv_undef) {
 			char *name = SvPVX(svp[ix]);
 			if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
 			    || *name == '&')		  /* anonymous code? */
@@ -2252,7 +2341,7 @@ PP(pp_entersub)
 	}
 #ifdef USE_THREADS
 	if (!hasargs) {
-	    AV* av = (AV*)curpad[0];
+	    AV* av = (AV*)PL_curpad[0];
 
 	    items = AvFILLp(av) + 1;
 	    if (items) {
@@ -2264,8 +2353,8 @@ PP(pp_entersub)
 	    }
 	}
 #endif /* USE_THREADS */		
-	SAVESPTR(curpad);
-    	curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+	SAVESPTR(PL_curpad);
+    	PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
 #ifndef USE_THREADS
 	if (hasargs)
 #endif /* USE_THREADS */
@@ -2274,17 +2363,17 @@ 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*)curpad[0];
+	    av = (AV*)PL_curpad[0];
 	    if (AvREAL(av)) {
 		av_clear(av);
 		AvREAL_off(av);
 	    }
 #ifndef USE_THREADS
-	    cx->blk_sub.savearray = GvAV(defgv);
-	    GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+	    cx->blk_sub.savearray = GvAV(PL_defgv);
+	    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_THREADS */
 	    cx->blk_sub.argarray = av;
 	    ++MARK;
@@ -2311,8 +2400,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));
@@ -2320,14 +2416,15 @@ PP(pp_entersub)
 }
 
 void
-sub_crush_depth(CV *cv)
+Perl_sub_crush_depth(pTHX_ CV *cv)
 {
     if (CvANON(cv))
-	warn("Deep recursion on anonymous subroutine");
+	Perl_warner(aTHX_ 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));
+	Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"", 
+		SvPVX(tmpstr));
     }
 }
 
@@ -2337,20 +2434,20 @@ PP(pp_aelem)
     SV** svp;
     I32 elem = POPi;
     AV* av = (AV*)POPs;
-    U32 lval = op->op_flags & OPf_MOD;
-    U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+    U32 lval = PL_op->op_flags & OPf_MOD;
+    U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
     SV *sv;
 
     if (elem > 0)
-	elem -= curcop->cop_arybase;
+	elem -= PL_curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)
 	RETPUSHUNDEF;
     svp = av_fetch(av, elem, lval && !defer);
     if (lval) {
-	if (!svp || *svp == &sv_undef) {
+	if (!svp || *svp == &PL_sv_undef) {
 	    SV* lv;
 	    if (!defer)
-		DIE(no_aelem, elem);
+		DIE(aTHX_ PL_no_aelem, elem);
 	    lv = sv_newmortal();
 	    sv_upgrade(lv, SVt_PVLV);
 	    LvTYPE(lv) = 'y';
@@ -2361,12 +2458,12 @@ PP(pp_aelem)
 	    PUSHs(lv);
 	    RETURN;
 	}
-	if (op->op_private & OPpLVAL_INTRO)
+	if (PL_op->op_private & OPpLVAL_INTRO)
 	    save_aelem(av, elem, svp);
-	else if (op->op_private & OPpDEREF)
-	    vivify_ref(*svp, op->op_private & OPpDEREF);
+	else if (PL_op->op_private & OPpDEREF)
+	    vivify_ref(*svp, PL_op->op_private & OPpDEREF);
     }
-    sv = (svp ? *svp : &sv_undef);
+    sv = (svp ? *svp : &PL_sv_undef);
     if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
 	sv = sv_mortalcopy(sv);
     PUSHs(sv);
@@ -2374,13 +2471,13 @@ PP(pp_aelem)
 }
 
 void
-vivify_ref(SV *sv, U32 to_what)
+Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
 {
     if (SvGMAGICAL(sv))
 	mg_get(sv);
     if (!SvOK(sv)) {
 	if (SvREADONLY(sv))
-	    croak(no_modify);
+	    Perl_croak(aTHX_ PL_no_modify);
 	if (SvTYPE(sv) < SVt_RV)
 	    sv_upgrade(sv, SVt_RV);
 	else if (SvTYPE(sv) >= SVt_PV) {
@@ -2407,25 +2504,46 @@ vivify_ref(SV *sv, U32 to_what)
 PP(pp_method)
 {
     djSP;
+    SV* sv = TOPs;
+
+    if (SvROK(sv)) {
+	SV* rsv = SvRV(sv);
+	if (SvTYPE(rsv) == SVt_PVCV) {
+	    SETs(rsv);
+	    RETURN;
+	}
+    }
+
+    SETs(method_common(sv, Null(U32*)));
+    RETURN;
+}
+
+PP(pp_method_named)
+{
+    djSP;
+    SV* sv = cSVOP->op_sv;
+    U32 hash = SvUVX(sv);
+
+    XPUSHs(method_common(sv, &hash));
+    RETURN;
+}
+
+STATIC SV *
+S_method_common(pTHX_ SV* meth, U32* hashp)
+{
+    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
     HV* stash;
     char* name;
+    STRLEN namelen;
     char* packname;
     STRLEN packlen;
 
-    if (SvROK(TOPs)) {
-	sv = SvRV(TOPs);
-	if (SvTYPE(sv) == SVt_PVCV) {
-	    SETs(sv);
-	    RETURN;
-	}
-    }
+    name = SvPV(meth, namelen);
+    sv = *(PL_stack_base + TOPMARK + 1);
 
-    name = SvPV(TOPs, na);
-    sv = *(stack_base + TOPMARK + 1);
-    
     if (SvGMAGICAL(sv))
         mg_get(sv);
     if (SvROK(sv))
@@ -2439,20 +2557,40 @@ PP(pp_method)
 	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
 	    !(ob=(SV*)GvIO(iogv)))
 	{
-	    if (!packname || !isIDFIRST(*packname))
-  DIE("Can't call method \"%s\" without a package or object reference", name);
+	    if (!packname || 
+		((*(U8*)packname >= 0xc0 && IN_UTF8)
+		    ? !isIDFIRST_utf8((U8*)packname)
+		    : !isIDFIRST(*packname)
+		))
+	    {
+		Perl_croak(aTHX_ "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;
 	}
-	*(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
+	*(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
     }
 
     if (!ob || !SvOBJECT(ob))
-	DIE("Can't call method \"%s\" on unblessed reference", name);
+	Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
+		   name);
 
     stash = SvSTASH(ob);
 
   fetch:
+    /* shortcut for simple names */
+    if (hashp) {
+	HE* he = hv_fetch_ent(stash, meth, 0, *hashp);
+	if (he) {
+	    gv = (GV*)HeVAL(he);
+	    if (isGV(gv) && GvCV(gv) &&
+		(!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
+		return (SV*)GvCV(gv);
+	}
+    }
+
     gv = gv_fetchmethod(stash, name);
     if (!gv) {
 	char* leaf = name;
@@ -2466,17 +2604,38 @@ PP(pp_method)
 		sep = p, leaf = p + 2;
 	}
 	if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
-	    packname = HvNAME(sep ? curcop->cop_stash : stash);
+	    packname = HvNAME(sep ? PL_curcop->cop_stash : stash);
 	    packlen = strlen(packname);
 	}
 	else {
 	    packname = name;
 	    packlen = sep - name;
 	}
-	DIE("Can't locate object method \"%s\" via package \"%.*s\"",
-	    leaf, (int)packlen, packname);
+	Perl_croak(aTHX_
+		   "Can't locate object method \"%s\" via package \"%s\"",
+		   leaf, packname);
     }
-    SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
-    RETURN;
+    return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }
 
+#ifdef USE_THREADS
+static void
+unset_cvowner(pTHXo_ void *cvarg)
+{
+    register CV* cv = (CV *) cvarg;
+#ifdef DEBUGGING
+    dTHR;
+#endif /* DEBUGGING */
+
+    DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
+			   thr, cv, SvPEEK((SV*)cv))));
+    MUTEX_LOCK(CvMUTEXP(cv));
+    DEBUG_S(if (CvDEPTH(cv) != 0)
+		PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+			      CvDEPTH(cv)););
+    assert(thr == CvOWNER(cv));
+    CvOWNER(cv) = 0;
+    MUTEX_UNLOCK(CvMUTEXP(cv));
+    SvREFCNT_dec(cv);
+}
+#endif /* USE_THREADS */