X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=8e3bf706da72866916d3f3f77e7f23dfee89e1b4;hb=dcb4812c733545a68ef39b77c2dc4f7d440de203;hp=2aee0611d5c432c85c666b2f3b82a7efdc026c6c;hpb=f93b4edd807be1c6102dad09f884828c27c4a58b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 2aee061..8e3bf70 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,6 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, 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.
@@ -18,48 +18,37 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
 /* Hot code. */
 
 #ifdef USE_THREADS
 static void
-unset_cvowner(cvarg)
-void *cvarg;
+unset_cvowner(void *cvarg)
 {
     register CV* cv = (CV *) cvarg;
 #ifdef DEBUGGING
     dTHR;
 #endif /* DEBUGGING */
 
-    DEBUG_L((fprintf(stderr, "0x%lx unsetting CvOWNER of 0x%lx:%s\n",
-		     (unsigned long)thr, (unsigned long)cv, SvPEEK((SV*)cv))));
+    DEBUG_L((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
+			   thr, cv, SvPEEK((SV*)cv))));
     MUTEX_LOCK(CvMUTEXP(cv));
-    assert(CvDEPTH(cv) == 0);
+    DEBUG_L(if (CvDEPTH(cv) != 0)
+		PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+			      CvDEPTH(cv)););
     assert(thr == CvOWNER(cv));
     CvOWNER(cv) = 0;
-    if (CvCONDP(cv))
-	COND_SIGNAL(CvCONDP(cv)); /* next please */
     MUTEX_UNLOCK(CvMUTEXP(cv));
     SvREFCNT_dec(cv);
 }
-
-#if 0
-void
-mutex_unlock(m)
-void *m;
-{
-#ifdef DEBUGGING
-    dTHR;
-    DEBUG_L((fprintf(stderr, "0x%lx unlocking mutex 0x%lx\n",
-			 (unsigned long) thr, (unsigned long) m)));
-#endif /* DEBUGGING */
-    MUTEX_UNLOCK((pthread_mutex_t *) m);
-}
-#endif
 #endif /* USE_THREADS */
 
 PP(pp_const)
 {
-    dSP;
+    djSP;
     XPUSHs(cSVOP->op_sv);
     RETURN;
 }
@@ -75,8 +64,8 @@ PP(pp_nextstate)
 
 PP(pp_gvsv)
 {
-    dSP;
-    EXTEND(sp,1);
+    djSP;
+    EXTEND(SP,1);
     if (op->op_private & OPpLVAL_INTRO)
 	PUSHs(save_scalar(cGVOP->op_gv));
     else
@@ -97,7 +86,7 @@ PP(pp_pushmark)
 
 PP(pp_stringify)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     STRLEN len;
     char *s;
     s = SvPV(TOPs,len);
@@ -108,72 +97,14 @@ PP(pp_stringify)
 
 PP(pp_gv)
 {
-    dSP;
+    djSP;
     XPUSHs((SV*)cGVOP->op_gv);
     RETURN;
 }
 
-PP(pp_gelem)
-{
-    GV *gv;
-    SV *sv;
-    SV *ref;
-    char *elem;
-    dSP;
-
-    sv = POPs;
-    elem = SvPV(sv, na);
-    gv = (GV*)POPs;
-    ref = Nullsv;
-    sv = Nullsv;
-    switch (elem ? *elem : '\0')
-    {
-    case 'A':
-	if (strEQ(elem, "ARRAY"))
-	    ref = (SV*)GvAV(gv);
-	break;
-    case 'C':
-	if (strEQ(elem, "CODE"))
-	    ref = (SV*)GvCV(gv);
-	break;
-    case 'F':
-	if (strEQ(elem, "FILEHANDLE"))
-	    ref = (SV*)GvIOp(gv);
-	break;
-    case 'G':
-	if (strEQ(elem, "GLOB"))
-	    ref = (SV*)gv;
-	break;
-    case 'H':
-	if (strEQ(elem, "HASH"))
-	    ref = (SV*)GvHV(gv);
-	break;
-    case 'N':
-	if (strEQ(elem, "NAME"))
-	    sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
-	break;
-    case 'P':
-	if (strEQ(elem, "PACKAGE"))
-	    sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
-	break;
-    case 'S':
-	if (strEQ(elem, "SCALAR"))
-	    ref = GvSV(gv);
-	break;
-    }
-    if (ref)
-	sv = newRV(ref);
-    if (sv)
-	sv_2mortal(sv);
-    else
-	sv = &sv_undef;
-    XPUSHs(sv);
-    RETURN;
-}
-
 PP(pp_and)
 {
-    dSP;
+    djSP;
     if (!SvTRUE(TOPs))
 	RETURN;
     else {
@@ -184,27 +115,23 @@ PP(pp_and)
 
 PP(pp_sassign)
 {
-    dSP; dPOPTOPssrl;
+    djSP; dPOPTOPssrl;
     MAGIC *mg;
 
     if (op->op_private & OPpASSIGN_BACKWARDS) {
 	SV *temp;
 	temp = left; left = right; right = temp;
     }
-    if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
-				!((mg = mg_find(left, 't')) && mg->mg_len & 1)))
-    {
+    if (tainting && tainted && !SvTAINTED(left))
 	TAINT_NOT;
-    }
-    SvSetSV(right, left);
-    SvSETMAGIC(right);
+    SvSetMagicSV(right, left);
     SETs(right);
     RETURN;
 }
 
 PP(pp_cond_expr)
 {
-    dSP;
+    djSP;
     if (SvTRUEx(POPs))
 	RETURNOP(cCONDOP->op_true);
     else
@@ -222,19 +149,9 @@ PP(pp_unstack)
     return NORMAL;
 }
 
-PP(pp_seq)
-{
-    dSP; tryAMAGICbinSET(seq,0); 
-    {
-      dPOPTOPssrl;
-      SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
-      RETURN;
-    }
-}
-
 PP(pp_concat)
 {
-  dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+  djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
   {
     dPOPTOPssrl;
     STRLEN len;
@@ -245,12 +162,15 @@ PP(pp_concat)
     }
     else if (SvGMAGICAL(TARG))
 	mg_get(TARG);
-    else if (!SvOK(TARG)) {
-	s = SvPV_force(TARG, len);
+    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
 	sv_setpv(TARG, "");	/* Suppress warning. */
+	s = SvPV_force(TARG, len);
     }
     s = SvPV(right,len);
-    sv_catpvn(TARG,s,len);
+    if (SvOK(TARG))
+	sv_catpvn(TARG,s,len);
+    else
+	sv_setpvn(TARG,s,len);	/* suppress warning */
     SETTARG;
     RETURN;
   }
@@ -258,13 +178,16 @@ PP(pp_concat)
 
 PP(pp_padsv)
 {
-    dSP; dTARGET;
+    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_HV|OPpDEREF_AV))
-	    provide_ref(op, curpad[op->op_targ]);
+        else if (op->op_private & OPpDEREF) {
+	    PUTBACK;
+	    vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
+	    SPAGAIN;
+	}
     }
     RETURN;
 }
@@ -277,20 +200,24 @@ PP(pp_readline)
 
 PP(pp_eq)
 {
-    dSP; tryAMAGICbinSET(eq,0); 
+    djSP; tryAMAGICbinSET(eq,0); 
     {
       dPOPnv;
-      SETs((TOPn == value) ? &sv_yes : &sv_no);
+      SETs(boolSV(TOPn == value));
       RETURN;
     }
 }
 
 PP(pp_preinc)
 {
-    dSP;
-    if (SvIOK(TOPs)) {
+    djSP;
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+	croak(no_modify);
+    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+    	SvIVX(TOPs) != IV_MAX)
+    {
 	++SvIVX(TOPs);
-	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+	SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
 	sv_inc(TOPs);
@@ -300,7 +227,7 @@ PP(pp_preinc)
 
 PP(pp_or)
 {
-    dSP;
+    djSP;
     if (SvTRUE(TOPs))
 	RETURN;
     else {
@@ -311,9 +238,9 @@ PP(pp_or)
 
 PP(pp_add)
 {
-    dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
+    djSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
     {
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_ul;
       SETn( left + right );
       RETURN;
     }
@@ -321,16 +248,21 @@ PP(pp_add)
 
 PP(pp_aelemfast)
 {
-    dSP;
+    djSP;
     AV *av = GvAV((GV*)cSVOP->op_sv);
-    SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
-    PUSHs(svp ? *svp : &sv_undef);
+    U32 lval = op->op_flags & OPf_MOD;
+    SV** svp = av_fetch(av, op->op_private, lval);
+    SV *sv = (svp ? *svp : &sv_undef);
+    EXTEND(SP, 1);
+    if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }
 
 PP(pp_join)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     MARK++;
     do_join(TARG, *MARK, MARK, SP);
     SP = MARK;
@@ -340,8 +272,20 @@ PP(pp_join)
 
 PP(pp_pushre)
 {
-    dSP;
+    djSP;
+#ifdef DEBUGGING
+    /*
+     * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
+     * will be enough to hold an OP*.
+     */
+    SV* sv = sv_newmortal();
+    sv_upgrade(sv, SVt_PVLV);
+    LvTYPE(sv) = '/';
+    Copy(&op, &LvTARGOFF(sv), 1, OP*);
+    XPUSHs(sv);
+#else
     XPUSHs((SV*)op);
+#endif
     RETURN;
 }
 
@@ -349,19 +293,42 @@ PP(pp_pushre)
 
 PP(pp_print)
 {
-    dSP; dMARK; dORIGMARK;
+    djSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
-    register FILE *fp;
+    register PerlIO *fp;
+    MAGIC *mg;
 
     if (op->op_flags & OPf_STACKED)
 	gv = (GV*)*++MARK;
     else
 	gv = defoutgv;
+    if (SvRMAGICAL(gv) && (mg = mg_find((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 ...
+	     */
+	    MEXTEND(SP, 1);
+	    ++MARK;
+	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+	    ++SP;
+	}
+	PUSHMARK(MARK - 1);
+	*MARK = mg->mg_obj;
+	PUTBACK;
+	ENTER;
+	perl_call_method("PRINT", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	MARK = ORIGMARK + 1;
+	*MARK = *SP;
+	SP = MARK;
+	RETURN;
+    }
     if (!(io = GvIO(gv))) {
 	if (dowarn) {
 	    SV* sv = sv_newmortal();
-            gv_fullname(sv,gv);
+            gv_fullname3(sv, gv, Nullch);
             warn("Filehandle %s never opened", SvPV(sv,na));
         }
 
@@ -371,7 +338,7 @@ PP(pp_print)
     else if (!(fp = IoOFP(io))) {
 	if (dowarn)  {
 	    SV* sv = sv_newmortal();
-            gv_fullname(sv,gv);
+            gv_fullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
 		warn("Filehandle %s opened only for input", SvPV(sv,na));
 	    else
@@ -388,7 +355,7 @@ PP(pp_print)
 		    break;
 		MARK++;
 		if (MARK <= SP) {
-		    if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
+		    if (PerlIO_write(fp, ofs, ofslen) == 0 || PerlIO_error(fp)) {
 			MARK--;
 			break;
 		    }
@@ -406,11 +373,11 @@ PP(pp_print)
 	    goto just_say_no;
 	else {
 	    if (orslen)
-		if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
+		if (PerlIO_write(fp, ors, orslen) == 0 || PerlIO_error(fp))
 		    goto just_say_no;
 
 	    if (IoFLAGS(io) & IOf_FLUSH)
-		if (Fflush(fp) == EOF)
+		if (PerlIO_flush(fp) == EOF)
 		    goto just_say_no;
 	}
     }
@@ -426,8 +393,7 @@ PP(pp_print)
 
 PP(pp_rv2av)
 {
-    dSP; dPOPss;
-
+    djSP; dPOPss;
     AV *av;
 
     if (SvROK(sv)) {
@@ -435,8 +401,6 @@ PP(pp_rv2av)
 	av = (AV*)SvRV(sv);
 	if (SvTYPE(av) != SVt_PVAV)
 	    DIE("Not an ARRAY reference");
-	if (op->op_private & OPpLVAL_INTRO)
-	    av = (AV*)save_svref((SV**)sv);
 	if (op->op_flags & OPf_REF) {
 	    PUSHs((SV*)av);
 	    RETURN;
@@ -451,6 +415,8 @@ PP(pp_rv2av)
 	    }
 	}
 	else {
+	    GV *gv;
+	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
 
@@ -463,6 +429,8 @@ PP(pp_rv2av)
 		    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)
 			RETURN;
 		    RETPUSHUNDEF;
@@ -470,11 +438,13 @@ PP(pp_rv2av)
 		sym = SvPV(sv,na);
 		if (op->op_private & HINT_STRICT_REFS)
 		    DIE(no_symref, sym, "an ARRAY");
-		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+		gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+	    } else {
+		gv = (GV*)sv;
 	    }
-	    av = GvAVn(sv);
+	    av = GvAVn(gv);
 	    if (op->op_private & OPpLVAL_INTRO)
-		av = save_ary(sv);
+		av = save_ary(gv);
 	    if (op->op_flags & OPf_REF) {
 		PUSHs((SV*)av);
 		RETURN;
@@ -484,8 +454,17 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
 	I32 maxarg = AvFILL(av) + 1;
-	EXTEND(SP, maxarg);
-	Copy(AvARRAY(av), SP+1, maxarg, SV*);
+	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;
+	    }
+	} 
+	else {
+	    Copy(AvARRAY(av), SP+1, maxarg, SV*);
+	}
 	SP += maxarg;
     }
     else {
@@ -498,25 +477,21 @@ PP(pp_rv2av)
 
 PP(pp_rv2hv)
 {
-
-    dSP; dTOPss;
-
+    djSP; dTOPss;
     HV *hv;
 
     if (SvROK(sv)) {
       wasref:
 	hv = (HV*)SvRV(sv);
-	if (SvTYPE(hv) != SVt_PVHV)
+	if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
 	    DIE("Not a HASH reference");
-	if (op->op_private & OPpLVAL_INTRO)
-	    hv = (HV*)save_svref((SV**)sv);
 	if (op->op_flags & OPf_REF) {
 	    SETs((SV*)hv);
 	    RETURN;
 	}
     }
     else {
-	if (SvTYPE(sv) == SVt_PVHV) {
+	if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
 	    hv = (HV*)sv;
 	    if (op->op_flags & OPf_REF) {
 		SETs((SV*)hv);
@@ -524,6 +499,8 @@ PP(pp_rv2hv)
 	    }
 	}
 	else {
+	    GV *gv;
+	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
 
@@ -536,6 +513,8 @@ PP(pp_rv2hv)
 		    if (op->op_flags & OPf_REF ||
 		      op->op_private & HINT_STRICT_REFS)
 			DIE(no_usym, "a HASH");
+		    if (dowarn)
+			warn(warn_uninit);
 		    if (GIMME == G_ARRAY) {
 			SP--;
 			RETURN;
@@ -545,11 +524,13 @@ PP(pp_rv2hv)
 		sym = SvPV(sv,na);
 		if (op->op_private & HINT_STRICT_REFS)
 		    DIE(no_symref, sym, "a HASH");
-		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+		gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+	    } else {
+		gv = (GV*)sv;
 	    }
-	    hv = GvHVn(sv);
+	    hv = GvHVn(gv);
 	    if (op->op_private & OPpLVAL_INTRO)
-		hv = save_hash(sv);
+		hv = save_hash(gv);
 	    if (op->op_flags & OPf_REF) {
 		SETs((SV*)hv);
 		RETURN;
@@ -563,12 +544,13 @@ PP(pp_rv2hv)
     }
     else {
 	dTARGET;
-	if (HvFILL(hv)) {
-	    sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
-	    sv_setpv(TARG, buf);
-	}
+	/* This bit is OK even when hv is really an AV */
+	if (HvFILL(hv))
+	    sv_setpvf(TARG, "%ld/%ld",
+		      (long)HvFILL(hv), (long)HvMAX(hv) + 1);
 	else
 	    sv_setiv(TARG, 0);
+	
 	SETTARG;
 	RETURN;
     }
@@ -576,7 +558,7 @@ PP(pp_rv2hv)
 
 PP(pp_aassign)
 {
-    dSP;
+    djSP;
     SV **lastlelem = stack_sp;
     SV **lastrelem = stack_base + POPMARK;
     SV **firstrelem = stack_base + POPMARK + 1;
@@ -588,6 +570,7 @@ PP(pp_aassign)
     register SV *sv;
     register AV *ary;
 
+    I32 gimme;
     HV *hash;
     I32 i;
     int magic;
@@ -601,8 +584,10 @@ PP(pp_aassign)
     if (op->op_private & OPpASSIGN_COMMON) {
         for (relem = firstrelem; relem <= lastrelem; relem++) {
             /*SUPPRESS 560*/
-            if (sv = *relem)
+            if (sv = *relem) {
+		TAINT_NOT;	/* Each item is independent */
                 *relem = sv_mortalcopy(sv);
+	    }
         }
     }
 
@@ -611,7 +596,7 @@ PP(pp_aassign)
     ary = Null(AV*);
     hash = Null(HV*);
     while (lelem <= lastlelem) {
-	tainted = 0;		/* Each item stands on its own, taintwise. */
+	TAINT_NOT;		/* Each item stands on its own, taintwise. */
 	sv = *lelem++;
 	switch (SvTYPE(sv)) {
 	case SVt_PVAV:
@@ -619,20 +604,25 @@ PP(pp_aassign)
 	    magic = SvMAGICAL(ary) != 0;
 	    
 	    av_clear(ary);
+	    av_extend(ary, lastrelem - relem);
 	    i = 0;
 	    while (relem <= lastrelem) {	/* gobble up all the rest */
+		SV **didstore;
 		sv = NEWSV(28,0);
 		assert(*relem);
 		sv_setsv(sv,*relem);
 		*(relem++) = sv;
-		(void)av_store(ary,i++,sv);
-		if (magic)
-		    mg_set(sv);
-		tainted = 0;
+		didstore = av_store(ary,i++,sv);
+		if (magic) {
+		    if (SvSMAGICAL(sv))
+			mg_set(sv);
+		    if (!didstore)
+			SvREFCNT_dec(sv);
+		}
+		TAINT_NOT;
 	    }
 	    break;
 	case SVt_PVHV: {
-		char *tmps;
 		SV *tmpstr;
 
 		hash = (HV*)sv;
@@ -640,27 +630,54 @@ PP(pp_aassign)
 		hv_clear(hash);
 
 		while (relem < lastrelem) {	/* gobble up all the rest */
-		    STRLEN len;
+		    HE *didstore;
 		    if (*relem)
 			sv = *(relem++);
 		    else
 			sv = &sv_no, relem++;
-		    tmps = SvPV(sv, len);
 		    tmpstr = NEWSV(29,0);
 		    if (*relem)
 			sv_setsv(tmpstr,*relem);	/* value */
 		    *(relem++) = tmpstr;
-		    (void)hv_store(hash,tmps,len,tmpstr,0);
-		    if (magic)
-			mg_set(tmpstr);
-		    tainted = 0;
+		    didstore = hv_store_ent(hash,sv,tmpstr,0);
+		    if (magic) {
+			if (SvSMAGICAL(tmpstr))
+			    mg_set(tmpstr);
+			if (!didstore)
+			    SvREFCNT_dec(tmpstr);
+		    }
+		    TAINT_NOT;
+		}
+		if (relem == lastrelem) {
+		    if (*relem) {
+			HE *didstore;
+			if (dowarn) {
+			    if (relem == firstrelem &&
+				SvROK(*relem) &&
+				( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+				  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+				warn("Reference found where even-sized list expected");
+			    else
+				warn("Odd number of elements in hash assignment");
+			}
+			tmpstr = NEWSV(29,0);
+			didstore = hv_store_ent(hash,*relem,tmpstr,0);
+			if (magic) {
+			    if (SvSMAGICAL(tmpstr))
+				mg_set(tmpstr);
+			    if (!didstore)
+				SvREFCNT_dec(tmpstr);
+			}
+			TAINT_NOT;
+		    }
+		    relem++;
 		}
 	    }
 	    break;
 	default:
 	    if (SvTHINKFIRST(sv)) {
 		if (SvREADONLY(sv) && curcop != &compiling) {
-		    if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
+		    if (!SvIMMORTAL(sv))
 			DIE(no_modify);
 		    if (relem <= lastrelem)
 			relem++;
@@ -702,12 +719,12 @@ PP(pp_aassign)
 	    if (delaymagic & DM_UID) {
 		if (uid != euid)
 		    DIE("No setreuid available");
-		(void)setuid(uid);
+		(void)PerlProc_setuid(uid);
 	    }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-	    uid = (int)getuid();
-	    euid = (int)geteuid();
+	    uid = (int)PerlProc_getuid();
+	    euid = (int)PerlProc_geteuid();
 	}
 	if (delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
@@ -731,35 +748,40 @@ PP(pp_aassign)
 	    if (delaymagic & DM_GID) {
 		if (gid != egid)
 		    DIE("No setregid available");
-		(void)setgid(gid);
+		(void)PerlProc_setgid(gid);
 	    }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-	    gid = (int)getgid();
-	    egid = (int)getegid();
+	    gid = (int)PerlProc_getgid();
+	    egid = (int)PerlProc_getegid();
 	}
 	tainting |= (uid && (euid != uid || egid != gid));
     }
     delaymagic = 0;
-    if (GIMME == G_ARRAY) {
+
+    gimme = GIMME_V;
+    if (gimme == G_VOID)
+	SP = firstrelem - 1;
+    else if (gimme == G_SCALAR) {
+	dTARGET;
+	SP = firstrelem;
+	SETi(lastrelem - firstrelem + 1);
+    }
+    else {
 	if (ary || hash)
 	    SP = lastrelem;
 	else
 	    SP = firstrelem + (lastlelem - firstlelem);
-	RETURN;
-    }
-    else {
-	dTARGET;
-	SP = firstrelem;
-		
-	SETi(lastrelem - firstrelem + 1);
-	RETURN;
+	lelem = firstlelem + (relem - firstrelem);
+	while (relem <= SP)
+	    *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef;
     }
+    RETURN;
 }
 
 PP(pp_match)
 {
-    dSP; dTARG;
+    djSP; dTARG;
     register PMOP *pm = cPMOP;
     register char *t;
     register char *s;
@@ -768,23 +790,31 @@ PP(pp_match)
     I32 safebase;
     char *truebase;
     register REGEXP *rx = pm->op_pmregexp;
+    bool rxtainted;
     I32 gimme = GIMME;
     STRLEN len;
     I32 minmatch = 0;
     I32 oldsave = savestack_ix;
+    I32 update_minmatch = 1;
+    SV *screamer;
 
     if (op->op_flags & OPf_STACKED)
 	TARG = POPs;
     else {
-	TARG = GvSV(defgv);
+	TARG = DEFSV;
 	EXTEND(SP,1);
     }
+    PUTBACK;				/* EVAL blocks need stack_sp. */
     s = SvPV(TARG, len);
     strend = s + len;
     if (!s)
 	DIE("panic: do_match");
+    rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+		 (tainted && (pm->op_pmflags & PMf_RETAINT)));
+    TAINT_NOT;
 
-    if (pm->op_pmflags & PMf_USED) {
+    if (pm->op_pmdynflags & PMdf_USED) {
+      failure:
 	if (gimme == G_ARRAY)
 	    RETURN;
 	RETPUSHNO;
@@ -794,6 +824,12 @@ PP(pp_match)
 	pm = 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;
     if (global = pm->op_pmflags & PMf_GLOBAL) {
 	rx->startp[0] = 0;
@@ -802,12 +838,15 @@ PP(pp_match)
 	    if (mg && mg->mg_len >= 0) {
 		rx->endp[0] = rx->startp[0] = s + 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;
+    safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
+		&& !sawampersand);
+    safebase = safebase ? 0  : REXEC_COPY_STR ;
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
 	SAVEINT(multiline);
 	multiline = pm->op_pmflags & PMf_MULTILINE;
@@ -816,56 +855,61 @@ PP(pp_match)
 play_it_again:
     if (global && rx->startp[0]) {
 	t = s = rx->endp[0];
-	if (s > strend)
+	if ((s + rx->minlen) > strend)
 	    goto nope;
-	minmatch = (s == rx->startp[0]);
+	if (update_minmatch++)
+	    minmatch = (s == rx->startp[0]);
     }
-    if (pm->op_pmshort) {
-	if (pm->op_pmflags & PMf_SCANFIRST) {
-	    if (SvSCREAM(TARG)) {
-		if (screamfirst[BmRARE(pm->op_pmshort)] < 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, pm->op_pmshort)))
+		else if (!(s = screaminstr(TARG, rx->check_substr, 
+					   rx->check_offset_min, 0, &p, 0)))
 		    goto nope;
-		else if (pm->op_pmflags & PMf_ALL)
+		else if ((rx->reganch & ROPT_CHECK_ALL)
+			 && !sawampersand && !SvTAIL(rx->check_substr))
 		    goto yup;
 	    }
-	    else if (!(s = fbm_instr((unsigned char*)s,
-	      (unsigned char*)strend, pm->op_pmshort)))
+	    else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
+				     (unsigned char*)strend, 
+				     rx->check_substr, 0)))
 		goto nope;
-	    else if (pm->op_pmflags & PMf_ALL)
+	    else if ((rx->reganch & ROPT_CHECK_ALL) && !sawampersand)
 		goto yup;
-	    if (s && rx->regback >= 0) {
-		++BmUSEFUL(pm->op_pmshort);
-		s -= rx->regback;
-		if (s < t)
-		    s = t;
+	    if (s && rx->check_offset_max < t - s) {
+		++BmUSEFUL(rx->check_substr);
+		s -= rx->check_offset_max;
 	    }
 	    else
 		s = t;
 	}
-	else if (!multiline) {
-	    if (*SvPVX(pm->op_pmshort) != *s ||
-	      bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
-		if (pm->op_pmflags & PMf_FOLD) {
-		    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
-			goto nope;
-		}
-		else
-		    goto nope;
-	    }
+	/* 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(pm->op_pmshort) < 0) {
-	    SvREFCNT_dec(pm->op_pmshort);
-	    pm->op_pmshort = Nullsv;	/* opt is being useless */
+	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 (pregexec(rx, s, strend, truebase, minmatch,
-      SvSCREAM(TARG) ? TARG : Nullsv,
-      safebase)) {
+    if (regexec_flags(rx, s, strend, truebase, minmatch,
+		      screamer, NULL, safebase))
+    {
 	curpm = pm;
 	if (pm->op_pmflags & PMf_ONCE)
-	    pm->op_pmflags |= PMf_USED;
+	    pm->op_pmdynflags |= PMdf_USED;
 	goto gotcha;
     }
     else
@@ -873,6 +917,9 @@ play_it_again:
     /*NOTREACHED*/
 
   gotcha:
+    if (rxtainted)
+	RX_MATCH_TAINTED_on(rx);
+    TAINT_IF(RX_MATCH_TAINTED(rx));
     if (gimme == G_ARRAY) {
 	I32 iters, i, len;
 
@@ -881,7 +928,9 @@ play_it_again:
 	    i = 1;
 	else
 	    i = 0;
+	SPAGAIN;			/* EVAL blocks could move the stack. */
 	EXTEND(SP, iters + i);
+	EXTEND_MORTAL(iters + i);
 	for (i = !i; i <= iters; i++) {
 	    PUSHs(sv_newmortal());
 	    /*SUPPRESS 560*/
@@ -892,8 +941,10 @@ play_it_again:
 	}
 	if (global) {
 	    truebase = rx->subbeg;
+	    strend = rx->subend;
 	    if (rx->startp[0] && rx->startp[0] == rx->endp[0])
 		++rx->endp[0];
+	    PUTBACK;			/* EVAL blocks may use stack */
 	    goto play_it_again;
 	}
 	LEAVE_SCOPE(oldsave);
@@ -909,51 +960,52 @@ play_it_again:
 		mg = mg_find(TARG, 'g');
 	    }
 	    if (rx->startp[0]) {
-		mg->mg_len = rx->endp[0] - truebase;
+		mg->mg_len = rx->endp[0] - rx->subbeg;
 		if (rx->startp[0] == rx->endp[0])
 		    mg->mg_flags |= MGf_MINMATCH;
 		else
 		    mg->mg_flags &= ~MGf_MINMATCH;
 	    }
-	    else
-		mg->mg_len = -1;
 	}
 	LEAVE_SCOPE(oldsave);
 	RETPUSHYES;
     }
 
-yup:
-    ++BmUSEFUL(pm->op_pmshort);
+yup:					/* Confirmed by check_substr */
+    if (rxtainted)
+	RX_MATCH_TAINTED_on(rx);
+    TAINT_IF(RX_MATCH_TAINTED(rx));
+    ++BmUSEFUL(rx->check_substr);
     curpm = pm;
     if (pm->op_pmflags & PMf_ONCE)
-	pm->op_pmflags |= PMf_USED;
+	pm->op_pmdynflags |= PMdf_USED;
+    Safefree(rx->subbase);
+    rx->subbase = Nullch;
     if (global) {
 	rx->subbeg = truebase;
 	rx->subend = strend;
 	rx->startp[0] = s;
-	rx->endp[0] = s + SvCUR(pm->op_pmshort);
+	rx->endp[0] = s + SvCUR(rx->check_substr);
 	goto gotcha;
     }
     if (sawampersand) {
 	char *tmps;
 
-	if (rx->subbase)
-	    Safefree(rx->subbase);
 	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(pm->op_pmshort);
+	rx->endp[0] = tmps + SvCUR(rx->check_substr);
     }
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
 nope:
-    if (pm->op_pmshort)
-	++BmUSEFUL(pm->op_pmshort);
+    if (rx->check_substr)
+	++BmUSEFUL(rx->check_substr);
 
 ret_no:
-    if (global) {
+    if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
 	    if (mg)
@@ -967,17 +1019,30 @@ ret_no:
 }
 
 OP *
-do_readline()
+do_readline(void)
 {
-    dTHR;
     dSP; dTARGETSTACKED;
     register SV *sv;
     STRLEN tmplen = 0;
     STRLEN offset;
-    FILE *fp;
+    PerlIO *fp;
     register IO *io = GvIO(last_in_gv);
     register I32 type = op->op_type;
+    I32 gimme = GIMME_V;
+    MAGIC *mg;
 
+    if (SvRMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(mg->mg_obj);
+	PUTBACK;
+	ENTER;
+	perl_call_method("READLINE", gimme);
+	LEAVE;
+	SPAGAIN;
+	if (gimme == G_SCALAR)
+	    SvSetMagicSV_nosteal(TARG, TOPs);
+	RETURN;
+    }
     fp = Nullfp;
     if (io) {
 	fp = IoIFP(io);
@@ -987,8 +1052,11 @@ do_readline()
 		    IoFLAGS(io) &= ~IOf_START;
 		    IoLINES(io) = 0;
 		    if (av_len(GvAVn(last_in_gv)) < 0) {
-			SV *tmpstr = newSVpv("-", 1); /* assume stdin */
-			av_push(GvAVn(last_in_gv), tmpstr);
+			do_open(last_in_gv,"-",1,FALSE,0,0,Nullfp);
+			sv_setpvn(GvSV(last_in_gv), "-", 1);
+			SvSETMAGIC(GvSV(last_in_gv));
+			fp = IoIFP(io);
+			goto have_fp;
 		    }
 		}
 		fp = nextargv(last_in_gv);
@@ -1014,7 +1082,7 @@ do_readline()
 		    char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
 		    char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
 		    $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
-		    FILE *tmpfp;
+		    PerlIO *tmpfp;
 		    STRLEN i;
 		    struct dsc$descriptor_s wilddsc
 		       = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
@@ -1027,7 +1095,7 @@ do_readline()
 		       ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
 		       but that's unsupported, so I don't want to do it now and
 		       have it bite someone in the future. */
-		    strcat(tmpfnam,tmpnam(NULL));
+		    strcat(tmpfnam,PerlLIO_tmpnam(NULL));
 		    cp = SvPV(tmpglob,i);
 		    for (; i; i--) {
 		       if (cp[i] == ';') hasver = 1;
@@ -1044,8 +1112,11 @@ do_readline()
 		           break;
 		       }
 		    }
-		    if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
-		        ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+		    if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
+		        Stat_t st;
+		        if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
+		          ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+		        else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
 		        if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
 		        while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
 		                                    &dfltdsc,NULL,NULL,NULL))&1)) {
@@ -1054,7 +1125,7 @@ do_readline()
 		            *(end++) = '\n';  *end = '\0';
 		            for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
 		            if (hasdir) {
-		              if (isunix) trim_unixpath(rstr,SvPVX(tmpglob));
+		              if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1);
 		              begin = rstr;
 		            }
 		            else {
@@ -1062,7 +1133,7 @@ do_readline()
 		                while (*(--begin) != ']' && *begin != '>') ;
 		                ++begin;
 		            }
-		            ok = (fputs(begin,tmpfp) != EOF);
+		            ok = (PerlIO_puts(tmpfp,begin) != EOF);
 		        }
 		        if (cxt) (void)lib$find_file_end(&cxt);
 		        if (ok && sts != RMS$_NMF &&
@@ -1071,23 +1142,35 @@ do_readline()
 		            if (!(sts & 1)) {
 		              SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
 		            }
-		            fclose(tmpfp);
+		            PerlIO_close(tmpfp);
 		            fp = NULL;
 		        }
 		        else {
-		           rewind(tmpfp);
+		           PerlIO_rewind(tmpfp);
 		           IoTYPE(io) = '<';
 		           IoIFP(io) = fp = tmpfp;
+		           IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
 		        }
 		    }
 		}
 #else /* !VMS */
 #ifdef DOSISH
+#ifdef OS2
+		sv_setpv(tmpcmd, "for a in ");
+		sv_catsv(tmpcmd, tmpglob);
+		sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
+#else
+#ifdef DJGPP
+		sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
+		sv_catsv(tmpcmd, tmpglob);
+#else
 		sv_setpv(tmpcmd, "perlglob ");
 		sv_catsv(tmpcmd, tmpglob);
 		sv_catpv(tmpcmd, " |");
-#else
-#ifdef CSH
+#endif /* !DJGPP */
+#endif /* !OS2 */
+#else /* !DOSISH */
+#if defined(CSH)
 		sv_setpvn(tmpcmd, cshname, cshlen);
 		sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
 		sv_catsv(tmpcmd, tmpglob);
@@ -1101,7 +1184,7 @@ do_readline()
 		sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
 #endif
 #endif /* !CSH */
-#endif /* !MSDOS */
+#endif /* !DOSISH */
 		(void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
 			      FALSE, 0, 0, Nullfp);
 		fp = IoIFP(io);
@@ -1115,18 +1198,17 @@ do_readline()
     if (!fp) {
 	if (dowarn && io && !(IoFLAGS(io) & IOf_START))
 	    warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
-	if (GIMME == G_SCALAR) {
+	if (gimme == G_SCALAR) {
 	    (void)SvOK_off(TARG);
 	    PUSHTARG;
 	}
 	RETURN;
     }
-    if (GIMME == G_ARRAY) {
-	sv = sv_2mortal(NEWSV(57, 80));
-	offset = 0;
-    }
-    else {
+  have_fp:
+    if (gimme == G_SCALAR) {
 	sv = TARG;
+	if (SvROK(sv))
+	    sv_unref(sv);
 	(void)SvUPGRADE(sv, SVt_PV);
 	tmplen = SvLEN(sv);	/* remember if already alloced */
 	if (!tmplen)
@@ -1136,9 +1218,13 @@ do_readline()
 	else
 	    offset = 0;
     }
+    else {
+	sv = sv_2mortal(NEWSV(57, 80));
+	offset = 0;
+    }
     for (;;) {
 	if (!sv_gets(sv, fp, offset)) {
-	    clearerr(fp);
+	    PerlIO_clearerr(fp);
 	    if (IoFLAGS(io) & IOf_ARGV) {
 		fp = nextargv(last_in_gv);
 		if (fp)
@@ -1147,20 +1233,23 @@ do_readline()
 		IoFLAGS(io) |= IOf_START;
 	    }
 	    else if (type == OP_GLOB) {
-		(void)do_close(last_in_gv, FALSE);
+		if (do_close(last_in_gv, FALSE) & ~0xFF)
+		    warn("internal error: glob failed");
 	    }
-	    if (GIMME == G_SCALAR) {
+	    if (gimme == G_SCALAR) {
 		(void)SvOK_off(TARG);
 		PUSHTARG;
 	    }
 	    RETURN;
 	}
+	/* This should not be marked tainted if the fp is marked clean */
+	if (!(IoFLAGS(io) & IOf_UNTAINT)) {
+	    TAINT;
+	    SvTAINTED_on(sv);
+	}
 	IoLINES(io)++;
+	SvSETMAGIC(sv);
 	XPUSHs(sv);
-	if (tainting) {
-	    tainted = TRUE;
-	    SvTAINT(sv); /* Anything from the outside world...*/
-	}
 	if (type == OP_GLOB) {
 	    char *tmps;
 
@@ -1175,12 +1264,12 @@ do_readline()
 		if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
 		    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
 			break;
-	    if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
+	    if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) {
 		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
 		continue;
 	    }
 	}
-	if (GIMME == G_ARRAY) {
+	if (gimme == G_ARRAY) {
 	    if (SvLEN(sv) - SvCUR(sv) > 20) {
 		SvLEN_set(sv, SvCUR(sv)+1);
 		Renew(SvPVX(sv), SvLEN(sv), char);
@@ -1188,7 +1277,7 @@ do_readline()
 	    sv = sv_2mortal(NEWSV(58, 80));
 	    continue;
 	}
-	else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
+	else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
 	    /* try to reclaim a bit of scalar space (only on 1st alloc) */
 	    if (SvCUR(sv) < 60)
 		SvLEN_set(sv, 80);
@@ -1202,59 +1291,88 @@ do_readline()
 
 PP(pp_enter)
 {
-    dSP;
-    register CONTEXT *cx;
-    I32 gimme;
+    djSP;
+    register PERL_CONTEXT *cx;
+    I32 gimme = OP_GIMME(op, -1);
 
-    /*
-     * We don't just use the GIMME macro here because it assumes there's
-     * already a context, which ain't necessarily so at initial startup.
-     */
-
-    if (op->op_flags & OPf_KNOW)
-	gimme = op->op_flags & OPf_LIST;
-    else if (cxstack_ix >= 0)
-	gimme = cxstack[cxstack_ix].blk_gimme;
-    else
-	gimme = G_SCALAR;
+    if (gimme == -1) {
+	if (cxstack_ix >= 0)
+	    gimme = cxstack[cxstack_ix].blk_gimme;
+	else
+	    gimme = G_SCALAR;
+    }
 
     ENTER;
 
     SAVETMPS;
-    PUSHBLOCK(cx, CXt_BLOCK, sp);
+    PUSHBLOCK(cx, CXt_BLOCK, SP);
 
     RETURN;
 }
 
 PP(pp_helem)
 {
-    dSP;
-    SV** svp;
+    djSP;
+    HE* he;
+    SV **svp;
     SV *keysv = POPs;
-    STRLEN keylen;
-    char *key = SvPV(keysv, keylen);
     HV *hv = (HV*)POPs;
-    I32 lval = op->op_flags & OPf_MOD;
+    U32 lval = op->op_flags & OPf_MOD;
+    U32 defer = op->op_private & OPpLVAL_DEFER;
+    SV *sv;
 
-    if (SvTYPE(hv) != SVt_PVHV)
+    if (SvTYPE(hv) == SVt_PVHV) {
+	he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+	svp = he ? &HeVAL(he) : 0;
+    }
+    else if (SvTYPE(hv) == SVt_PVAV) {
+	svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
+    }
+    else {
 	RETPUSHUNDEF;
-    svp = hv_fetch(hv, key, keylen, lval);
-    if (lval) {
-	if (!svp || *svp == &sv_undef)
-	    DIE(no_helem, key);
-	if (op->op_private & OPpLVAL_INTRO)
-	    save_svref(svp);
-	else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
-	    provide_ref(op, *svp);
     }
-    PUSHs(svp ? *svp : &sv_undef);
+    if (lval) {
+	if (!svp || *svp == &sv_undef) {
+	    SV* lv;
+	    SV* key2;
+	    if (!defer)
+		DIE(no_helem, SvPV(keysv, na));
+	    lv = sv_newmortal();
+	    sv_upgrade(lv, SVt_PVLV);
+	    LvTYPE(lv) = 'y';
+	    sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0);
+	    SvREFCNT_dec(key2);	/* sv_magic() increments refcount */
+	    LvTARG(lv) = SvREFCNT_inc(hv);
+	    LvTARGLEN(lv) = 1;
+	    PUSHs(lv);
+	    RETURN;
+	}
+	if (op->op_private & OPpLVAL_INTRO) {
+	    if (HvNAME(hv) && isGV(*svp))
+		save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
+	    else
+		save_helem(hv, keysv, svp);
+	}
+	else if (op->op_private & OPpDEREF)
+	    vivify_ref(*svp, op->op_private & OPpDEREF);
+    }
+    sv = (svp ? *svp : &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(),
+     * and thus the later pp_sassign() will fail to mg_get() the
+     * old value.  This should also cure problems with delayed
+     * mg_get()s.  GSAR 98-07-03 */
+    if (!lval && SvGMAGICAL(sv))
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }
 
 PP(pp_leave)
 {
-    dSP;
-    register CONTEXT *cx;
+    djSP;
+    register PERL_CONTEXT *cx;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -1267,35 +1385,38 @@ PP(pp_leave)
 
     POPBLOCK(cx,newpm);
 
-    if (op->op_flags & OPf_KNOW)
-	gimme = op->op_flags & OPf_LIST;
-    else if (cxstack_ix >= 0)
-	gimme = cxstack[cxstack_ix].blk_gimme;
-    else
-	gimme = G_SCALAR;
+    gimme = OP_GIMME(op, -1);
+    if (gimme == -1) {
+	if (cxstack_ix >= 0)
+	    gimme = cxstack[cxstack_ix].blk_gimme;
+	else
+	    gimme = G_SCALAR;
+    }
 
-    if (gimme == G_SCALAR) {
-	if (op->op_private & OPpLEAVE_VOID)
-	    SP = newsp;
+    TAINT_NOT;
+    if (gimme == G_VOID)
+	SP = newsp;
+    else if (gimme == G_SCALAR) {
+	MARK = newsp + 1;
+	if (MARK <= SP)
+	    if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
+		*MARK = TOPs;
+	    else
+		*MARK = sv_mortalcopy(TOPs);
 	else {
-	    MARK = newsp + 1;
-	    if (MARK <= SP)
-		if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
-		    *MARK = TOPs;
-		else
-		    *MARK = sv_mortalcopy(TOPs);
-	    else {
-		MEXTEND(mark,0);
-		*MARK = &sv_undef;
-	    }
-	    SP = MARK;
+	    MEXTEND(mark,0);
+	    *MARK = &sv_undef;
 	}
+	SP = MARK;
     }
-    else {
-	for (mark = newsp + 1; mark <= SP; mark++)
-	    if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+    else if (gimme == G_ARRAY) {
+	/* in case LEAVE wipes old return values */
+	for (mark = newsp + 1; mark <= SP; mark++) {
+	    if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
 		*mark = sv_mortalcopy(*mark);
-		/* in case LEAVE wipes old return values */
+		TAINT_NOT;	/* Each item is independent */
+	    }
+	}
     }
     curpm = newpm;	/* Don't pop $1 et al till now */
 
@@ -1306,35 +1427,80 @@ PP(pp_leave)
 
 PP(pp_iter)
 {
-    dSP;
-    register CONTEXT *cx;
-    SV *sv;
+    djSP;
+    register PERL_CONTEXT *cx;
+    SV* sv;
     AV* av;
 
-    EXTEND(sp, 1);
+    EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
     if (cx->cx_type != CXt_LOOP)
 	DIE("panic: pp_iter");
+
     av = cx->blk_loop.iterary;
-    if (av == stack && cx->blk_loop.iterix >= cx->blk_oldsp)
-	RETPUSHNO;
+    if (SvTYPE(av) != SVt_PVAV) {
+	/* iterate ($min .. $max) */
+	if (cx->blk_loop.iterlval) {
+	    /* string increment */
+	    register SV* cur = cx->blk_loop.iterlval;
+	    STRLEN maxlen;
+	    char *max = SvPV((SV*)av, maxlen);
+	    if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
+		sv_setsv(*cx->blk_loop.itervar, cur);
+		if (strEQ(SvPVX(cur), max))
+		    sv_setiv(cur, 0); /* terminate next time */
+		else
+		    sv_inc(cur);
+		RETPUSHYES;
+	    }
+	    RETPUSHNO;
+	}
+	/* integer increment */
+	if (cx->blk_loop.iterix > cx->blk_loop.itermax)
+	    RETPUSHNO;
+	sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+	RETPUSHYES;
+    }
 
-    if (cx->blk_loop.iterix >= AvFILL(av))
+    /* iterate array */
+    if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
 	RETPUSHNO;
 
-    if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) {
+    SvREFCNT_dec(*cx->blk_loop.itervar);
+
+    if (sv = (SvMAGICAL(av)) 
+	    ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
+	    : AvARRAY(av)[++cx->blk_loop.iterix])
 	SvTEMP_off(sv);
-	*cx->blk_loop.itervar = sv;
-    }
     else
-	*cx->blk_loop.itervar = &sv_undef;
+	sv = &sv_undef;
+    if (av != curstack && SvIMMORTAL(sv)) {
+	SV *lv = cx->blk_loop.iterlval;
+	if (lv && SvREFCNT(lv) > 1) {
+	    SvREFCNT_dec(lv);
+	    lv = Nullsv;
+	}
+	if (lv)
+	    SvREFCNT_dec(LvTARG(lv));
+	else {
+	    lv = cx->blk_loop.iterlval = NEWSV(26, 0);
+	    sv_upgrade(lv, SVt_PVLV);
+	    LvTYPE(lv) = 'y';
+	    sv_magic(lv, Nullsv, 'y', Nullch, 0);
+	}
+	LvTARG(lv) = SvREFCNT_inc(av);
+	LvTARGOFF(lv) = cx->blk_loop.iterix;
+	LvTARGLEN(lv) = (UV) -1;
+	sv = (SV*)lv;
+    }
 
+    *cx->blk_loop.itervar = SvREFCNT_inc(sv);
     RETPUSHYES;
 }
 
 PP(pp_subst)
 {
-    dSP; dTARG;
+    djSP; dTARG;
     register PMOP *pm = cPMOP;
     PMOP *rpm = pm;
     register SV *dstr;
@@ -1348,24 +1514,38 @@ PP(pp_subst)
     I32 maxiters;
     register I32 i;
     bool once;
+    bool rxtainted;
     char *orig;
     I32 safebase;
     register REGEXP *rx = pm->op_pmregexp;
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = savestack_ix;
+    I32 update_minmatch = 1;
+    SV *screamer;
 
-    if (pm->op_pmflags & PMf_CONST)	/* known replacement string? */
-	dstr = POPs;
+    /* known replacement string? */
+    dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
     if (op->op_flags & OPf_STACKED)
 	TARG = POPs;
     else {
-	TARG = GvSV(defgv);
+	TARG = DEFSV;
 	EXTEND(SP,1);
-    }
+    }                  
+    if (SvREADONLY(TARG)
+	|| (SvTYPE(TARG) > SVt_PVLV
+	    && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
+	croak(no_modify);
+    PUTBACK;
+
     s = SvPV(TARG, len);
-    if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
+    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)
+	rxtainted |= 2;
+    TAINT_NOT;
 
   force_it:
     if (!pm || !s)
@@ -1378,177 +1558,184 @@ PP(pp_subst)
 	pm = curpm;
 	rx = pm->op_pmregexp;
     }
-    safebase = ((!rx || !rx->nparens) && !sawampersand);
+    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;
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
 	SAVEINT(multiline);
 	multiline = pm->op_pmflags & PMf_MULTILINE;
     }
     orig = m = s;
-    if (pm->op_pmshort) {
-	if (pm->op_pmflags & PMf_SCANFIRST) {
-	    if (SvSCREAM(TARG)) {
-		if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
+    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, pm->op_pmshort)))
+		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, (unsigned char*)strend,
-	      pm->op_pmshort)))
+	    else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min, 
+				     (unsigned char*)strend,
+				     rx->check_substr, 0)))
 		goto nope;
-	    if (s && rx->regback >= 0) {
-		++BmUSEFUL(pm->op_pmshort);
-		s -= rx->regback;
-		if (s < m)
-		    s = m;
+	    if (s && rx->check_offset_max < s - m) {
+		++BmUSEFUL(rx->check_substr);
+		s -= rx->check_offset_max;
 	    }
 	    else
 		s = m;
 	}
-	else if (!multiline) {
-	    if (*SvPVX(pm->op_pmshort) != *s ||
-	      bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
-		if (pm->op_pmflags & PMf_FOLD) {
-		    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
-			goto nope;
-		}
-		else
-		    goto nope;
-	    }
+	/* 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(pm->op_pmshort) < 0) {
-	    SvREFCNT_dec(pm->op_pmshort);
-	    pm->op_pmshort = Nullsv;	/* opt is being useless */
+	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;
 	}
     }
+
+    /* only replace once? */
     once = !(rpm->op_pmflags & PMf_GLOBAL);
-    if (rpm->op_pmflags & PMf_CONST) {	/* known replacement string? */
-	c = SvPV(dstr, clen);
-	if (clen <= rx->minlen) {
-					/* can do inplace substitution */
-	    if (pregexec(rx, s, strend, orig, 0,
-	      SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
-		if (force_on_match) {
-		    force_on_match = 0;
-		    s = SvPV_force(TARG, len);
-		    goto force_it;
+
+    /* known replacement string? */
+    c = dstr ? SvPV(dstr, clen) : Nullch;
+
+    /* can do inplace substitution? */
+    if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
+	&& !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
+	if (!regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+	    SPAGAIN;
+	    PUSHs(&sv_no);
+	    LEAVE_SCOPE(oldsave);
+	    RETURN;
+	}
+	if (force_on_match) {
+	    force_on_match = 0;
+	    s = SvPV_force(TARG, len);
+	    goto force_it;
+	}
+	d = s;
+	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];
+	    }
+	    s = orig;
+	    if (m - s > strend - d) {  /* faster to shorten from end */
+		if (clen) {
+		    Copy(c, m, clen, char);
+		    m += clen;
 		}
-		if (rx->subbase) 	/* oops, no we can't */
-		    goto long_way;
-		d = s;
-		curpm = pm;
-		SvSCREAM_off(TARG);	/* disable possible screamer */
-		if (once) {
-		    m = rx->startp[0];
-		    d = rx->endp[0];
-		    s = orig;
-		    if (m - s > strend - d) {	/* faster to shorten from end */
-			if (clen) {
-			    Copy(c, m, clen, char);
-			    m += clen;
-			}
-			i = strend - d;
-			if (i > 0) {
-			    Move(d, m, i, char);
-			    m += i;
-			}
-			*m = '\0';
-			SvCUR_set(TARG, m - s);
-			(void)SvPOK_only(TARG);
-			SvSETMAGIC(TARG);
-			PUSHs(&sv_yes);
-			LEAVE_SCOPE(oldsave);
-			RETURN;
-		    }
-		    /*SUPPRESS 560*/
-		    else if (i = m - s) {	/* faster from front */
-			d -= clen;
-			m = d;
-			sv_chop(TARG, d-i);
-			s += i;
-			while (i--)
-			    *--d = *--s;
-			if (clen)
-			    Copy(c, m, clen, char);
-			(void)SvPOK_only(TARG);
-			SvSETMAGIC(TARG);
-			PUSHs(&sv_yes);
-			LEAVE_SCOPE(oldsave);
-			RETURN;
-		    }
-		    else if (clen) {
-			d -= clen;
-			sv_chop(TARG, d);
-			Copy(c, d, clen, char);
-			(void)SvPOK_only(TARG);
-			SvSETMAGIC(TARG);
-			PUSHs(&sv_yes);
-			LEAVE_SCOPE(oldsave);
-			RETURN;
-		    }
-		    else {
-			sv_chop(TARG, d);
-			(void)SvPOK_only(TARG);
-			SvSETMAGIC(TARG);
-			PUSHs(&sv_yes);
-			LEAVE_SCOPE(oldsave);
-			RETURN;
-		    }
-		    /* NOTREACHED */
+		i = strend - d;
+		if (i > 0) {
+		    Move(d, m, i, char);
+		    m += i;
 		}
-		do {
-		    if (iters++ > maxiters)
-			DIE("Substitution loop");
-		    m = rx->startp[0];
-		    /*SUPPRESS 560*/
-		    if (i = m - s) {
-			if (s != d)
-			    Move(s, d, i, char);
-			d += i;
-		    }
-		    if (clen) {
-			Copy(c, d, clen, char);
-			d += clen;
-		    }
-		    s = rx->endp[0];
-		} while (pregexec(rx, s, strend, orig, s == m,
-		    Nullsv, TRUE));	/* (don't match same null twice) */
-		if (s != d) {
-		    i = strend - s;
-		    SvCUR_set(TARG, d - SvPVX(TARG) + i);
-		    Move(s, d, i+1, char);		/* include the Null */
+		*m = '\0';
+		SvCUR_set(TARG, m - s);
+	    }
+	    /*SUPPRESS 560*/
+	    else if (i = m - s) {	/* faster from front */
+		d -= clen;
+		m = d;
+		sv_chop(TARG, d-i);
+		s += i;
+		while (i--)
+		    *--d = *--s;
+		if (clen)
+		    Copy(c, m, clen, char);
+	    }
+	    else if (clen) {
+		d -= clen;
+		sv_chop(TARG, d);
+		Copy(c, d, clen, char);
+	    }
+	    else {
+		sv_chop(TARG, d);
+	    }
+	    TAINT_IF(rxtainted & 1);
+	    SPAGAIN;
+	    PUSHs(&sv_yes);
+	}
+	else {
+	    do {
+		if (iters++ > maxiters)
+		    DIE("Substitution loop");
+		rxtainted |= RX_MATCH_TAINTED(rx);
+		m = rx->startp[0];
+		/*SUPPRESS 560*/
+		if (i = m - s) {
+		    if (s != d)
+			Move(s, d, i, char);
+		    d += i;
 		}
-		(void)SvPOK_only(TARG);
-		SvSETMAGIC(TARG);
-		PUSHs(sv_2mortal(newSViv((I32)iters)));
-		LEAVE_SCOPE(oldsave);
-		RETURN;
+		if (clen) {
+		    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 */
+	    if (s != d) {
+		i = strend - s;
+		SvCUR_set(TARG, d - SvPVX(TARG) + i);
+		Move(s, d, i+1, char);		/* include the NUL */
 	    }
-	    PUSHs(&sv_no);
-	    LEAVE_SCOPE(oldsave);
-	    RETURN;
+	    TAINT_IF(rxtainted & 1);
+	    SPAGAIN;
+	    PUSHs(sv_2mortal(newSViv((I32)iters)));
+	}
+	(void)SvPOK_only(TARG);
+	TAINT_IF(rxtainted);
+	if (SvSMAGICAL(TARG)) {
+	    PUTBACK;
+	    mg_set(TARG);
+	    SPAGAIN;
 	}
+	SvTAINT(TARG);
+	LEAVE_SCOPE(oldsave);
+	RETURN;
     }
-    else
-	c = Nullch;
-    if (pregexec(rx, s, strend, orig, 0,
-      SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
-    long_way:
+
+    if (regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
 	if (force_on_match) {
 	    force_on_match = 0;
 	    s = SvPV_force(TARG, len);
 	    goto force_it;
 	}
-	dstr = NEWSV(25, sv_len(TARG));
+	rxtainted |= RX_MATCH_TAINTED(rx);
+	dstr = NEWSV(25, len);
 	sv_setpvn(dstr, m, s-m);
 	curpm = pm;
 	if (!c) {
-	    register CONTEXT *cx;
+	    register PERL_CONTEXT *cx;
+	    SPAGAIN;
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplroot);
 	}
 	do {
 	    if (iters++ > maxiters)
 		DIE("Substitution loop");
+	    rxtainted |= RX_MATCH_TAINTED(rx);
 	    if (rx->subbase && rx->subbase != orig) {
 		m = s;
 		s = orig;
@@ -1563,8 +1750,7 @@ PP(pp_subst)
 		sv_catpvn(dstr, c, clen);
 	    if (once)
 		break;
-	} while (pregexec(rx, s, strend, orig, s == m, Nullsv,
-	    safebase));
+	} while (regexec_flags(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
 	sv_catpvn(dstr, s, strend - s);
 
 	(void)SvOOK_off(TARG);
@@ -1575,18 +1761,24 @@ PP(pp_subst)
 	SvPVX(dstr) = 0;
 	sv_free(dstr);
 
+	TAINT_IF(rxtainted & 1);
+	SPAGAIN;
+	PUSHs(sv_2mortal(newSViv((I32)iters)));
+
 	(void)SvPOK_only(TARG);
+	TAINT_IF(rxtainted);
 	SvSETMAGIC(TARG);
-	PUSHs(sv_2mortal(newSViv((I32)iters)));
+	SvTAINT(TARG);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
-    PUSHs(&sv_no);
-    LEAVE_SCOPE(oldsave);
-    RETURN;
+    goto ret_no;
 
 nope:
-    ++BmUSEFUL(pm->op_pmshort);
+    ++BmUSEFUL(rx->check_substr);
+
+ret_no:         
+    SPAGAIN;
     PUSHs(&sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
@@ -1594,7 +1786,7 @@ nope:
 
 PP(pp_grepwhile)
 {
-    dSP;
+    djSP;
 
     if (SvTRUEx(POPs))
 	stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
@@ -1602,20 +1794,21 @@ PP(pp_grepwhile)
     LEAVE;					/* exit inner scope */
 
     /* All done yet? */
-    if (stack_base + *markstack_ptr > sp) {
+    if (stack_base + *markstack_ptr > SP) {
 	I32 items;
+	I32 gimme = GIMME_V;
 
 	LEAVE;					/* exit outer scope */
 	(void)POPMARK;				/* pop src */
 	items = --*markstack_ptr - markstack_ptr[-1];
 	(void)POPMARK;				/* pop dst */
 	SP = stack_base + POPMARK;		/* pop original mark */
-	if (GIMME != G_ARRAY) {
+	if (gimme == G_SCALAR) {
 	    dTARGET;
 	    XPUSHi(items);
-	    RETURN;
 	}
-	SP += items;
+	else if (gimme == G_ARRAY)
+	    SP += items;
 	RETURN;
     }
     else {
@@ -1626,7 +1819,7 @@ PP(pp_grepwhile)
 
 	src = stack_base[*markstack_ptr];
 	SvTEMP_off(src);
-	GvSV(defgv) = src;
+	DEFSV = src;
 
 	RETURNOP(cLOGOP->op_other);
     }
@@ -1634,57 +1827,100 @@ PP(pp_grepwhile)
 
 PP(pp_leavesub)
 {
-    dSP;
+    djSP;
     SV **mark;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
+    struct block_sub cxsub;
 
     POPBLOCK(cx,newpm);
-    POPSUB(cx);
-
+    POPSUB1(cx);	/* Delay POPSUB2 until stack values are safe */
+ 
+    TAINT_NOT;
     if (gimme == G_SCALAR) {
 	MARK = newsp + 1;
-	if (MARK <= SP)
-	    if (SvFLAGS(TOPs) & SVs_TEMP)
-		*MARK = TOPs;
-	    else
-		*MARK = sv_mortalcopy(TOPs);
-	else {
-	    MEXTEND(mark,0);
+	if (MARK <= SP) {
+	    if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+		if (SvTEMP(TOPs)) {
+		    *MARK = SvREFCNT_inc(TOPs);
+		    FREETMPS;
+		    sv_2mortal(*MARK);
+		} else {
+		    FREETMPS;
+		    *MARK = sv_mortalcopy(TOPs);
+		}
+	    } else
+		*MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
+	} else {
+	    MEXTEND(MARK, 0);
 	    *MARK = &sv_undef;
 	}
 	SP = MARK;
     }
-    else {
-	for (mark = newsp + 1; mark <= SP; mark++)
-	    if (!(SvFLAGS(*mark) & SVs_TEMP))
-		*mark = sv_mortalcopy(*mark);
-		/* in case LEAVE wipes old return values */
+    else if (gimme == G_ARRAY) {
+	for (MARK = newsp + 1; MARK <= SP; MARK++) {
+	    if (!SvTEMP(*MARK)) {
+		*MARK = sv_mortalcopy(*MARK);
+		TAINT_NOT;	/* Each item is independent */
+	    }
+	}
     }
+    PUTBACK;
+    
+    POPSUB2();		/* Stack values are safe: release CV and @_ ... */
+    curpm = newpm;	/* ... and pop $1 et al */
 
-    if (cx->blk_sub.hasargs) {		/* You don't exist; go away. */
-	AV* av = cx->blk_sub.argarray;
+    LEAVE;
+    return pop_return();
+}
 
-	av_clear(av);
-	AvREAL_off(av);
+STATIC CV *
+get_db_sub(SV **svp, CV *cv)
+{
+    dTHR;
+    SV *dbsv = GvSV(DBsub);
+
+    if (!PERLDB_SUB_NN) {
+	GV *gv = CvGV(cv);
+
+	save_item(dbsv);
+	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+	     || strEQ(GvNAME(gv), "END") 
+	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+		 !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
+		    && (gv = (GV*)*svp) ))) {
+	    /* Use GV from the stack as a fallback. */
+	    /* GV is potentially non-unique, or contain different CV. */
+	    sv_setsv(dbsv, newRV((SV*)cv));
+	}
+	else {
+	    gv_efullname3(dbsv, gv, Nullch);
+	}
+    }
+    else {
+	SvUPGRADE(dbsv, SVt_PVIV);
+	SvIOK_on(dbsv);
+	SAVEIV(SvIVX(dbsv));
+	SvIVX(dbsv) = (IV)cv;		/* Do it the quickest way  */
     }
-    curpm = newpm;	/* Don't pop $1 et al till now */
 
-    LEAVE;
-    PUTBACK;
-    return pop_return();
+    if (CvXSUB(cv))
+	curcopdb = curcop;
+    cv = GvCV(DBsub);
+    return cv;
 }
 
 PP(pp_entersub)
 {
-    dSP; dPOPss;
+    djSP; dPOPss;
     GV *gv;
     HV *stash;
     register CV *cv;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
     I32 gimme;
+    bool hasargs = (op->op_flags & OPf_STACKED) != 0;
 
     if (!sv)
 	DIE("Not a CODE reference");
@@ -1693,11 +1929,19 @@ PP(pp_entersub)
 	if (!SvROK(sv)) {
 	    char *sym;
 
-	    if (sv == &sv_yes)		/* unfound import, ignore */
+	    if (sv == &sv_yes) {		/* unfound import, ignore */
+		if (hasargs)
+		    SP = stack_base + POPMARK;
 		RETURN;
-	    if (!SvOK(sv))
+	    }
+	    if (SvGMAGICAL(sv)) {
+		mg_get(sv);
+		sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
+	    }
+	    else
+		sym = SvPV(sv, na);
+	    if (!sym)
 		DIE(no_usym, "a subroutine");
-	    sym = SvPV(sv,na);
 	    if (op->op_private & HINT_STRICT_REFS)
 		DIE(no_symref, sym, "a subroutine");
 	    cv = perl_get_cv(sym, TRUE);
@@ -1714,7 +1958,7 @@ PP(pp_entersub)
 	cv = (CV*)sv;
 	break;
     case SVt_PVGV:
-	if (!(cv = GvCV((GV*)sv)))
+	if (!(cv = GvCVu((GV*)sv)))
 	    cv = sv_2cv(sv, &stash, &gv, TRUE);
 	break;
     }
@@ -1727,171 +1971,175 @@ PP(pp_entersub)
 	DIE("Not a CODE reference");
 
     if (!CvROOT(cv) && !CvXSUB(cv)) {
-	if (gv = CvGV(cv)) {
-	    SV *tmpstr;
-	    GV *ngv;
-	    if (SvFAKE(cv) && GvCV(gv) != cv) {	/* autoloaded stub? */
-		cv = GvCV(gv);
-		if (SvTYPE(sv) == SVt_PVGV) {
-		    SvREFCNT_dec(GvCV((GV*)sv));
-		    GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
-		}
-		goto retry;
-	    }
-	    tmpstr = sv_newmortal();
-	    gv_efullname(tmpstr, gv);
-	    ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
-	    if (ngv && ngv != gv && (cv = GvCV(ngv))) {	/* One more chance... */
-		gv = ngv;
-		sv_setsv(GvSV(CvGV(cv)), tmpstr);	/* Set CV's $AUTOLOAD */
-		if (tainting)
-		    sv_unmagic(GvSV(CvGV(cv)), 't');
-		goto retry;
-	    }
-	    else
-		DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
-	}
-	DIE("Undefined subroutine called");
-    }
-
-    gimme = GIMME;
-    if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) {
-	sv = GvSV(DBsub);
-	save_item(sv);
-	if (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) {
-	    /* GV is potentially non-unique */
-	    sv_setsv(sv, newRV((SV*)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");
+	/* autoloaded stub? */
+	if (cv != GvCV(gv)) {
+	    cv = GvCV(gv);
+	    goto retry;
 	}
-	else {
-	    gv = CvGV(cv);
-	    gv_efullname(sv,gv);
+	/* should call AUTOLOAD now? */
+	if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+				   FALSE)))
+	{
+	    cv = GvCV(autogv);
+	    goto retry;
 	}
-	cv = GvCV(DBsub);
-	if (!cv)
-	    DIE("No DBsub routine");
+	/* sorry */
+	sub_name = sv_newmortal();
+	gv_efullname3(sub_name, gv, Nullch);
+	DIE("Undefined subroutine &%s called", SvPVX(sub_name));
     }
 
+    gimme = GIMME_V;
+    if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv))
+	cv = get_db_sub(&sv, cv);
+    if (!cv)
+	DIE("No DBsub routine");
+
 #ifdef USE_THREADS
+    /*
+     * First we need to check if the sub or method requires locking.
+     * If so, we gain a lock on the CV, the first argument or the
+     * stash (for static methods), as appropriate. This has to be
+     * inline because for FAKE_THREADS, COND_WAIT inlines code to
+     * reschedule by returning a new op.
+     */
     MUTEX_LOCK(CvMUTEXP(cv));
-    if (!CvCONDP(cv)) {
-#ifdef DEBUGGING
-	DEBUG_L((fprintf(stderr, "0x%lx entering fast %s\n",
-				 (unsigned long)thr, SvPEEK((SV*)cv))));
-#endif /* DEBUGGING */
-	MUTEX_UNLOCK(CvMUTEXP(cv)); /* fast sub wants neither sync nor clone */
-    }
-    else if (SvFLAGS(cv) & SVp_SYNC) {
-	/*
-	 * It's a synchronised CV. Wait until it's free unless
-	 * we own it already (in which case we're recursing).
-	 */
-	if (CvOWNER(cv) && CvOWNER(cv) != thr) {
-	    do {
-		DEBUG_L((fprintf(stderr, "0x%lx wait for 0x%lx to leave %s\n",
-				 (unsigned long)thr,(unsigned long)CvOWNER(cv),
-				 SvPEEK((SV*)cv))));
-		COND_WAIT(CvCONDP(cv), CvMUTEXP(cv)); /* yawn */
-	    } while (CvOWNER(cv));
-	}
-	CvOWNER(cv) = thr;	/* Assert ownership */
-	SvREFCNT_inc(cv);
+    if (CvFLAGS(cv) & CVf_LOCKED) {
+	MAGIC *mg;	
+	if (CvFLAGS(cv) & CVf_METHOD) {
+	    if (SP > stack_base + TOPMARK)
+		sv = *(stack_base + TOPMARK + 1);
+	    else {
+		MUTEX_UNLOCK(CvMUTEXP(cv));
+		croak("no argument for locked method call");
+	    }
+	    if (SvROK(sv))
+		sv = SvRV(sv);
+	    else {		
+		STRLEN len;
+		char *stashname = SvPV(sv, len);
+		sv = (SV*)gv_stashpvn(stashname, len, TRUE);
+	    }
+	}
+	else {
+	    sv = (SV*)cv;
+	}
 	MUTEX_UNLOCK(CvMUTEXP(cv));
-	if (CvDEPTH(cv) == 0)
-	    SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+	mg = condpair_magic(sv);
+	MUTEX_LOCK(MgMUTEXP(mg));
+	if (MgOWNER(mg) == thr)
+	    MUTEX_UNLOCK(MgMUTEXP(mg));
+	else {
+	    while (MgOWNER(mg))
+		COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+	    MgOWNER(mg) = thr;
+	    DEBUG_L(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));
     }
+    /*
+     * Now we have permission to enter the sub, we must distinguish
+     * four cases. (0) It's an XSUB (in which case we don't care
+     * about ownership); (1) it's ours already (and we're recursing);
+     * (2) it's free (but we may already be using a cached clone);
+     * (3) another thread owns it. Case (1) is easy: we just use it.
+     * Case (2) means we look for a clone--if we have one, use it
+     * otherwise grab ownership of cv. Case (3) means we look for a
+     * clone (for non-XSUBs) and have to create one if we don't
+     * already have one.
+     * Why look for a clone in case (2) when we could just grab
+     * ownership of cv straight away? Well, we could be recursing,
+     * i.e. we originally tried to enter cv while another thread
+     * owned it (hence we used a clone) but it has been freed up
+     * and we're now recursing into it. It may or may not be "better"
+     * to use the clone but at least CvDEPTH can be trusted.
+     */
+    if (CvOWNER(cv) == thr || CvXSUB(cv))
+	MUTEX_UNLOCK(CvMUTEXP(cv));
     else {
+	/* Case (2) or (3) */
+	SV **svp;
+	
 	/*
-	 * It's an ordinary unsynchronised CV so we must distinguish
-	 * three cases. (1) It's ours already (and we're recursing);
-	 * (2) it's free (but we may already be using a cached clone);
-	 * (3) another thread owns it. Case (1) is easy: we just use it.
-	 * Case (2) means we look for a clone--if we have one, use it
-	 * otherwise grab ownership of cv. Case (3) means look we for a
-	 * clone and have to create one if we don't already have one.
-	 * Why look for a clone in case (2) when we could just grab
-	 * ownership of cv straight away? Well, we could be recursing,
-	 * i.e. we originally tried to enter cv while another thread
-	 * owned it (hence we used a clone) but it has been freed up
-	 * and we're now recursing into it. It may or may not be "better"
-	 * to use the clone but at least CvDEPTH can be trusted.
-	 */
-	if (CvOWNER(cv) == thr)
+	 * XXX Might it be better to release CvMUTEXP(cv) while we
+     	 * do the hv_fetch? We might find someone has pinched it
+     	 * when we look again, in which case we would be in case
+     	 * (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)))
+	{
+	    /* We already have a clone to use */
 	    MUTEX_UNLOCK(CvMUTEXP(cv));
+	    cv = *(CV**)svp;
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "entersub: %p already has clone %p:%s\n",
+				  thr, cv, SvPEEK((SV*)cv)));
+	    CvOWNER(cv) = thr;
+	    SvREFCNT_inc(cv);
+	    if (CvDEPTH(cv) == 0)
+		SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+	}
 	else {
-	    /* Case (2) or (3) */
-	    SV **svp;
-	    
-	    /*
-	     * XXX Might it be better to release CvMUTEXP(cv) while we
-	     * do the hv_fetch? We might find someone has pinched it
-	     * when we look again, in which case we would be in case
-	     * (3) instead of (2) so we'd have to clone. Would the fact
-	     * that we released the mutex more quickly make up for this?
-	     */
-	    svp = hv_fetch(cvcache, (char *)cv, sizeof(cv), FALSE);
-	    if (svp) {
-		/* We already have a clone to use */
-		MUTEX_UNLOCK(CvMUTEXP(cv));
-		cv = *(CV**)svp;
-		DEBUG_L(fprintf(stderr,
-				"entersub: 0x%lx already has clone 0x%lx:%s\n",
-				(unsigned long) thr, (unsigned long) cv,
-				SvPEEK((SV*)cv)));
+	    /* (2) => grab ownership of cv. (3) => make clone */
+	    if (!CvOWNER(cv)) {
 		CvOWNER(cv) = thr;
 		SvREFCNT_inc(cv);
-		if (CvDEPTH(cv) == 0)
-		    SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
-	    }
-	    else {
-		/* (2) => grab ownership of cv. (3) => make clone */
-		if (!CvOWNER(cv)) {
-		    CvOWNER(cv) = thr;
-		    SvREFCNT_inc(cv);
-		    MUTEX_UNLOCK(CvMUTEXP(cv));
-		    DEBUG_L(fprintf(stderr,
-				    "entersub: 0x%lx grabbing 0x%lx:%s\n",
-				    (unsigned long) thr, (unsigned long) cv,
-				    SvPEEK((SV*)cv)));
-		} else {
-		    /* Make a new clone. */
-		    CV *clonecv;
-		    SvREFCNT_inc(cv); /* don't let it vanish from under us */
-		    MUTEX_UNLOCK(CvMUTEXP(cv));
-		    DEBUG_L((fprintf(stderr,
-				     "entersub: 0x%lx cloning 0x%lx:%s\n",
-				     (unsigned long) thr, (unsigned long) cv,
-				     SvPEEK((SV*)cv))));
-		    /*
-		     * We're creating a new clone so there's no race
-		     * between the original MUTEX_UNLOCK and the
-		     * SvREFCNT_inc since no one will be trying to undef
-		     * it out from underneath us. At least, I don't think
-		     * there's a race...
-		     */
-		    clonecv = cv_clone(cv);
-		    SvREFCNT_dec(cv); /* finished with this */
-		    hv_store(cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
-		    CvOWNER(clonecv) = thr;
-		    cv = clonecv;
-		    SvREFCNT_inc(cv);
-		}
-		assert(CvDEPTH(cv) == 0);
-		SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+		MUTEX_UNLOCK(CvMUTEXP(cv));
+		DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			    "entersub: %p grabbing %p:%s in stash %s\n",
+			    thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
+	    			HvNAME(CvSTASH(cv)) : "(none)"));
+	    } else {
+		/* Make a new clone. */
+		CV *clonecv;
+		SvREFCNT_inc(cv); /* don't let it vanish from under us */
+		MUTEX_UNLOCK(CvMUTEXP(cv));
+		DEBUG_L((PerlIO_printf(PerlIO_stderr(),
+				       "entersub: %p cloning %p:%s\n",
+				       thr, cv, SvPEEK((SV*)cv))));
+		/*
+	    	 * We're creating a new clone so there's no race
+		 * between the original MUTEX_UNLOCK and the
+		 * SvREFCNT_inc since no one will be trying to undef
+		 * it out from underneath us. At least, I don't think
+		 * there's a race...
+		 */
+	     	clonecv = cv_clone(cv);
+    		SvREFCNT_dec(cv); /* finished with this */
+		hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
+		CvOWNER(clonecv) = thr;
+		cv = clonecv;
+		SvREFCNT_inc(cv);
 	    }
+	    DEBUG_L(if (CvDEPTH(cv) != 0)
+			PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+				      CvDEPTH(cv)););
+	    SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
 	}
-    }	
+    }
 #endif /* USE_THREADS */
 
-    gimme = GIMME;
-
     if (CvXSUB(cv)) {
 	if (CvOLDSTYLE(cv)) {
 	    I32 (*fp3)_((int,int,int));
 	    dMARK;
 	    register I32 items = SP - MARK;
-	    while (sp > mark) {
-		sp[1] = sp[0];
-		sp--;
+					/* We dont worry to copy from @_. */
+	    while (SP > mark) {
+		SP[1] = SP[0];
+		SP--;
 	    }
 	    stack_sp = mark + 1;
 	    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
@@ -1904,7 +2152,37 @@ PP(pp_entersub)
 	    I32 markix = TOPMARK;
 
 	    PUTBACK;
-	    (void)(*CvXSUB(cv))(cv);
+
+	    if (!hasargs) {
+		/* Need to copy @_ to stack. Alternative may be to
+		 * switch stack to @_, and copy return values
+		 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
+		AV* av;
+		I32 items;
+#ifdef USE_THREADS
+		av = (AV*)curpad[0];
+#else
+		av = GvAV(defgv);
+#endif /* USE_THREADS */		
+		items = AvFILLp(av) + 1;   /* @_ is not tieable */
+
+		if (items) {
+		    /* Mark is at the end of the stack. */
+		    EXTEND(SP, items);
+		    Copy(AvARRAY(av), SP + 1, items, SV*);
+		    SP += items;
+		    PUTBACK ;		    
+		}
+	    }
+	    if (curcopdb) {		/* We assume that the first
+					   XSUB in &DB::sub is the
+					   called one. */
+		SAVESPTR(curcop);
+		curcop = curcopdb;
+		curcopdb = NULL;
+	    }
+	    /* Do we need to open block here? XXXX */
+	    (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
 
 	    /* Enforce some sanity in scalar context. */
 	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
@@ -1921,7 +2199,6 @@ PP(pp_entersub)
     else {
 	dMARK;
 	register I32 items = SP - MARK;
-	I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
 	AV* padlist = CvPADLIST(cv);
 	SV** svp = AvARRAY(padlist);
 	push_return(op->op_next);
@@ -1931,20 +2208,22 @@ PP(pp_entersub)
 	if (CvDEPTH(cv) < 2)
 	    (void)SvREFCNT_inc(cv);
 	else {	/* save temporaries on recursion? */
-	    if (CvDEPTH(cv) == 100 && dowarn)
-		warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
-	    if (CvDEPTH(cv) > AvFILL(padlist)) {
+	    if (CvDEPTH(cv) == 100 && dowarn 
+		  && !(PERLDB_SUB && cv == GvCV(DBsub)))
+		sub_crush_depth(cv);
+	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
 		SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
-		I32 ix = AvFILL((AV*)svp[1]);
+		I32 ix = AvFILLp((AV*)svp[1]);
 		svp = AvARRAY(svp[0]);
 		for ( ;ix > 0; ix--) {
 		    if (svp[ix] != &sv_undef) {
 			char *name = SvPVX(svp[ix]);
-			if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
-			    av_store(newpad, ix,
-				SvREFCNT_inc(oldpad[ix]) );
+			if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
+			    || *name == '&')		  /* anonymous code? */
+			{
+			    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
 			}
 			else {				/* our own lexical */
 			    if (*name == '@')
@@ -1966,23 +2245,47 @@ PP(pp_entersub)
 		av_store(newpad, 0, (SV*)av);
 		AvFLAGS(av) = AVf_REIFY;
 		av_store(padlist, CvDEPTH(cv), (SV*)newpad);
-		AvFILL(padlist) = CvDEPTH(cv);
+		AvFILLp(padlist) = CvDEPTH(cv);
 		svp = AvARRAY(padlist);
 	    }
 	}
-	SAVESPTR(curpad);
-	curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-	if (hasargs) {
+#ifdef USE_THREADS
+	if (!hasargs) {
 	    AV* av = (AV*)curpad[0];
+
+	    items = AvFILLp(av) + 1;
+	    if (items) {
+		/* Mark is at the end of the stack. */
+		EXTEND(SP, items);
+		Copy(AvARRAY(av), SP + 1, items, SV*);
+		SP += items;
+		PUTBACK ;		    
+	    }
+	}
+#endif /* USE_THREADS */		
+	SAVESPTR(curpad);
+    	curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#ifndef USE_THREADS
+	if (hasargs)
+#endif /* USE_THREADS */
+	{
+	    AV* av;
 	    SV** ary;
 
+#if 0
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+	    			  "%p entersub preparing @_\n", thr));
+#endif
+	    av = (AV*)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);
+#endif /* USE_THREADS */
 	    cx->blk_sub.argarray = av;
-	    GvAV(defgv) = cx->blk_sub.argarray;
 	    ++MARK;
 
 	    if (items > AvMAX(av) + 1) {
@@ -1999,7 +2302,7 @@ PP(pp_entersub)
 		}
 	    }
 	    Copy(MARK,AvARRAY(av),items,SV*);
-	    AvFILL(av) = items - 1;
+	    AvFILLp(av) = items - 1;
 	    
 	    while (items--) {
 		if (*MARK)
@@ -2007,48 +2310,94 @@ PP(pp_entersub)
 		MARK++;
 	    }
 	}
+#if 0
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "%p entersub returning %p\n", thr, CvSTART(cv)));
+#endif
 	RETURNOP(CvSTART(cv));
     }
 }
 
+void
+sub_crush_depth(CV *cv)
+{
+    if (CvANON(cv))
+	warn("Deep recursion on anonymous subroutine");
+    else {
+	SV* tmpstr = sv_newmortal();
+	gv_efullname3(tmpstr, CvGV(cv), Nullch);
+	warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr));
+    }
+}
+
 PP(pp_aelem)
 {
-    dSP;
+    djSP;
     SV** svp;
     I32 elem = POPi;
-    AV *av = (AV*)POPs;
-    I32 lval = op->op_flags & OPf_MOD;
+    AV* av = (AV*)POPs;
+    U32 lval = op->op_flags & OPf_MOD;
+    U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+    SV *sv;
 
     if (elem > 0)
 	elem -= curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)
 	RETPUSHUNDEF;
-    svp = av_fetch(av, elem, lval);
+    svp = av_fetch(av, elem, lval && !defer);
     if (lval) {
-	if (!svp || *svp == &sv_undef)
-	    DIE(no_aelem, elem);
+	if (!svp || *svp == &sv_undef) {
+	    SV* lv;
+	    if (!defer)
+		DIE(no_aelem, elem);
+	    lv = sv_newmortal();
+	    sv_upgrade(lv, SVt_PVLV);
+	    LvTYPE(lv) = 'y';
+	    sv_magic(lv, Nullsv, 'y', Nullch, 0);
+	    LvTARG(lv) = SvREFCNT_inc(av);
+	    LvTARGOFF(lv) = elem;
+	    LvTARGLEN(lv) = 1;
+	    PUSHs(lv);
+	    RETURN;
+	}
 	if (op->op_private & OPpLVAL_INTRO)
-	    save_svref(svp);
-	else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
-	    provide_ref(op, *svp);
-    }
-    PUSHs(svp ? *svp : &sv_undef);
+	    save_aelem(av, elem, svp);
+	else if (op->op_private & OPpDEREF)
+	    vivify_ref(*svp, op->op_private & OPpDEREF);
+    }
+    sv = (svp ? *svp : &sv_undef);
+    if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }
 
 void
-provide_ref(o, sv)
-OP* o;
-SV* sv;
+vivify_ref(SV *sv, U32 to_what)
 {
     if (SvGMAGICAL(sv))
 	mg_get(sv);
     if (!SvOK(sv)) {
 	if (SvREADONLY(sv))
 	    croak(no_modify);
-	(void)SvUPGRADE(sv, SVt_RV);
-	SvRV(sv) = (o->op_private & OPpDEREF_HV ?
-		    (SV*)newHV() : (SV*)newAV());
+	if (SvTYPE(sv) < SVt_RV)
+	    sv_upgrade(sv, SVt_RV);
+	else if (SvTYPE(sv) >= SVt_PV) {
+	    (void)SvOOK_off(sv);
+	    Safefree(SvPVX(sv));
+	    SvLEN(sv) = SvCUR(sv) = 0;
+	}
+	switch (to_what) {
+	case OPpDEREF_SV:
+	    SvRV(sv) = NEWSV(355,0);
+	    break;
+	case OPpDEREF_AV:
+	    SvRV(sv) = (SV*)newAV();
+	    break;
+	case OPpDEREF_HV:
+	    SvRV(sv) = (SV*)newHV();
+	    break;
+	}
 	SvROK_on(sv);
 	SvSETMAGIC(sv);
     }
@@ -2056,64 +2405,77 @@ SV* sv;
 
 PP(pp_method)
 {
-    dSP;
+    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
-    SV* nm;
+    HV* stash;
+    char* name;
+    char* packname;
+    STRLEN packlen;
+
+    if (SvROK(TOPs)) {
+	sv = SvRV(TOPs);
+	if (SvTYPE(sv) == SVt_PVCV) {
+	    SETs(sv);
+	    RETURN;
+	}
+    }
 
-    nm = TOPs;
+    name = SvPV(TOPs, na);
     sv = *(stack_base + TOPMARK + 1);
     
-    gv = 0;
     if (SvGMAGICAL(sv))
         mg_get(sv);
     if (SvROK(sv))
 	ob = (SV*)SvRV(sv);
     else {
 	GV* iogv;
-	char* packname = 0;
 
+	packname = Nullch;
 	if (!SvOK(sv) ||
-	    !(packname = SvPV(sv, na)) ||
+	    !(packname = SvPV(sv, packlen)) ||
 	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
 	    !(ob=(SV*)GvIO(iogv)))
 	{
-	    char *name = SvPV(nm, na);
-	    HV *stash;
-	    if (!packname || !isALPHA(*packname))
-DIE("Can't call method \"%s\" without a package or object reference", name);
-	    if (!(stash = gv_stashpv(packname, FALSE))) {
-		if (gv_stashpv("UNIVERSAL", FALSE))
-		    stash = gv_stashpv(packname, TRUE);
-		else
-		    DIE("Can't call method \"%s\" in empty package \"%s\"",
-			name, packname);
-	    }
-	    gv = gv_fetchmethod(stash,name);
-	    if (!gv)
-		DIE("Can't locate object method \"%s\" via package \"%s\"",
-		    name, packname);
-	    SETs(gv);
-	    RETURN;
+	    if (!packname || !isIDFIRST(*packname))
+  DIE("Can't call method \"%s\" without a package or object reference", name);
+	    stash = gv_stashpvn(packname, packlen, TRUE);
+	    goto fetch;
 	}
-	*(stack_base + TOPMARK + 1) = sv_2mortal(newRV(iogv));
+	*(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
     }
 
-    if (!ob || !SvOBJECT(ob)) {
-	char *name = SvPV(nm, na);
+    if (!ob || !SvOBJECT(ob))
 	DIE("Can't call method \"%s\" on unblessed reference", name);
-    }
 
-    if (!gv) {		/* nothing cached */
-	char *name = SvPV(nm, na);
-	gv = gv_fetchmethod(SvSTASH(ob),name);
-	if (!gv)
-	    DIE("Can't locate object method \"%s\" via package \"%s\"",
-		name, HvNAME(SvSTASH(ob)));
-    }
+    stash = SvSTASH(ob);
+
+  fetch:
+    gv = gv_fetchmethod(stash, name);
+    if (!gv) {
+	char* leaf = name;
+	char* sep = Nullch;
+	char* p;
 
-    SETs(gv);
+	for (p = name; *p; p++) {
+	    if (*p == '\'')
+		sep = p, leaf = p + 1;
+	    else if (*p == ':' && *(p + 1) == ':')
+		sep = p, leaf = p + 2;
+	}
+	if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
+	    packname = HvNAME(sep ? 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);
+    }
+    SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
     RETURN;
 }