X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=32f378a59f239338a3c6b6498436aa915405dcbe;hb=d9f975991d53b93e15d703c5e48ae9aea5162637;hp=e1f4476dda84d166497fccb1e331f5db37a0dd08;hpb=fb73857aa0bfa8ed43d4d2f972c564c70a57e0c4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index e1f4476..32f378a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -18,11 +18,37 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
 /* 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);
+}
+#endif /* USE_THREADS */
+
 PP(pp_const)
 {
-    dSP;
+    djSP;
     XPUSHs(cSVOP->op_sv);
     RETURN;
 }
@@ -38,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
@@ -60,7 +86,7 @@ PP(pp_pushmark)
 
 PP(pp_stringify)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     STRLEN len;
     char *s;
     s = SvPV(TOPs,len);
@@ -71,14 +97,14 @@ PP(pp_stringify)
 
 PP(pp_gv)
 {
-    dSP;
+    djSP;
     XPUSHs((SV*)cGVOP->op_gv);
     RETURN;
 }
 
 PP(pp_and)
 {
-    dSP;
+    djSP;
     if (!SvTRUE(TOPs))
 	RETURN;
     else {
@@ -89,7 +115,7 @@ PP(pp_and)
 
 PP(pp_sassign)
 {
-    dSP; dPOPTOPssrl;
+    djSP; dPOPTOPssrl;
     MAGIC *mg;
 
     if (op->op_private & OPpASSIGN_BACKWARDS) {
@@ -105,7 +131,7 @@ PP(pp_sassign)
 
 PP(pp_cond_expr)
 {
-    dSP;
+    djSP;
     if (SvTRUEx(POPs))
 	RETURNOP(cCONDOP->op_true);
     else
@@ -125,7 +151,7 @@ PP(pp_unstack)
 
 PP(pp_concat)
 {
-  dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+  djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
   {
     dPOPTOPssrl;
     STRLEN len;
@@ -152,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)
+        else if (op->op_private & OPpDEREF) {
+	    PUTBACK;
 	    vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
+	    SPAGAIN;
+	}
     }
     RETURN;
 }
@@ -171,7 +200,7 @@ PP(pp_readline)
 
 PP(pp_eq)
 {
-    dSP; tryAMAGICbinSET(eq,0); 
+    djSP; tryAMAGICbinSET(eq,0); 
     {
       dPOPnv;
       SETs(boolSV(TOPn == value));
@@ -181,7 +210,7 @@ PP(pp_eq)
 
 PP(pp_preinc)
 {
-    dSP;
+    djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 	croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -198,7 +227,7 @@ PP(pp_preinc)
 
 PP(pp_or)
 {
-    dSP;
+    djSP;
     if (SvTRUE(TOPs))
 	RETURN;
     else {
@@ -209,7 +238,7 @@ PP(pp_or)
 
 PP(pp_add)
 {
-    dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
+    djSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
     {
       dPOPTOPnnrl_ul;
       SETn( left + right );
@@ -219,7 +248,7 @@ 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);
@@ -228,7 +257,7 @@ PP(pp_aelemfast)
 
 PP(pp_join)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     MARK++;
     do_join(TARG, *MARK, MARK, SP);
     SP = MARK;
@@ -238,7 +267,7 @@ PP(pp_join)
 
 PP(pp_pushre)
 {
-    dSP;
+    djSP;
 #ifdef DEBUGGING
     /*
      * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
@@ -259,7 +288,7 @@ PP(pp_pushre)
 
 PP(pp_print)
 {
-    dSP; dMARK; dORIGMARK;
+    djSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
     register PerlIO *fp;
@@ -269,9 +298,12 @@ PP(pp_print)
 	gv = (GV*)*++MARK;
     else
 	gv = defoutgv;
-    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
 	if (MARK == ORIGMARK) {
-	    EXTEND(SP, 1);
+	    /* 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;
@@ -356,7 +388,7 @@ PP(pp_print)
 
 PP(pp_rv2av)
 {
-    dSP; dPOPss;
+    djSP; dPOPss;
     AV *av;
 
     if (SvROK(sv)) {
@@ -417,8 +449,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 {
@@ -431,13 +472,13 @@ 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_flags & OPf_REF) {
 	    SETs((SV*)hv);
@@ -445,7 +486,7 @@ PP(pp_rv2hv)
 	}
     }
     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);
@@ -498,11 +539,13 @@ PP(pp_rv2hv)
     }
     else {
 	dTARGET;
+	/* 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;
     }
@@ -510,7 +553,7 @@ PP(pp_rv2hv)
 
 PP(pp_aassign)
 {
-    dSP;
+    djSP;
     SV **lastlelem = stack_sp;
     SV **lastrelem = stack_base + POPMARK;
     SV **firstrelem = stack_base + POPMARK + 1;
@@ -650,12 +693,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
@@ -679,12 +722,12 @@ 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));
     }
@@ -712,7 +755,7 @@ PP(pp_aassign)
 
 PP(pp_match)
 {
-    dSP; dTARG;
+    djSP; dTARG;
     register PMOP *pm = cPMOP;
     register char *t;
     register char *s;
@@ -726,13 +769,15 @@ PP(pp_match)
     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)
@@ -740,6 +785,7 @@ PP(pp_match)
     TAINT_NOT;
 
     if (pm->op_pmflags & PMf_USED) {
+      failure:
 	if (gimme == G_ARRAY)
 	    RETURN;
 	RETPUSHNO;
@@ -749,6 +795,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;
@@ -765,6 +817,7 @@ PP(pp_match)
 	gimme = G_SCALAR;			/* accidental array context? */
     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;
@@ -778,43 +831,52 @@ play_it_again:
 	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)))
 		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
-		|| (pm->op_pmslen > 1
-		    && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
+	/* 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)
@@ -826,7 +888,7 @@ play_it_again:
     /*NOTREACHED*/
 
   gotcha:
-    TAINT_IF(rx->exec_tainted);
+    TAINT_IF(RX_MATCH_TAINTED(rx));
     if (gimme == G_ARRAY) {
 	I32 iters, i, len;
 
@@ -835,6 +897,7 @@ 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++) {
@@ -850,6 +913,7 @@ play_it_again:
 	    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);
@@ -876,9 +940,9 @@ play_it_again:
 	RETPUSHYES;
     }
 
-yup:
-    TAINT_IF(rx->exec_tainted);
-    ++BmUSEFUL(pm->op_pmshort);
+yup:					/* Confirmed by check_substr */
+    TAINT_IF(RX_MATCH_TAINTED(rx));
+    ++BmUSEFUL(rx->check_substr);
     curpm = pm;
     if (pm->op_pmflags & PMf_ONCE)
 	pm->op_pmflags |= PMf_USED;
@@ -888,7 +952,7 @@ yup:
 	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) {
@@ -898,14 +962,14 @@ yup:
 	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 && !(pm->op_pmflags & PMf_CONTINUE)) {
@@ -922,7 +986,7 @@ ret_no:
 }
 
 OP *
-do_readline()
+do_readline(void)
 {
     dSP; dTARGETSTACKED;
     register SV *sv;
@@ -934,7 +998,7 @@ do_readline()
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
+    if (SvRMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
 	PUSHMARK(SP);
 	XPUSHs(mg->mg_obj);
 	PUTBACK;
@@ -995,7 +1059,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;
@@ -1057,9 +1121,14 @@ do_readline()
 		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, " |");
+#endif /* !DJGPP */
 #endif /* !OS2 */
 #else /* !DOSISH */
 #if defined(CSH)
@@ -1155,7 +1224,7 @@ 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;
 	    }
@@ -1182,8 +1251,8 @@ do_readline()
 
 PP(pp_enter)
 {
-    dSP;
-    register CONTEXT *cx;
+    djSP;
+    register PERL_CONTEXT *cx;
     I32 gimme = OP_GIMME(op, -1);
 
     if (gimme == -1) {
@@ -1196,25 +1265,33 @@ PP(pp_enter)
     ENTER;
 
     SAVETMPS;
-    PUSHBLOCK(cx, CXt_BLOCK, sp);
+    PUSHBLOCK(cx, CXt_BLOCK, SP);
 
     RETURN;
 }
 
 PP(pp_helem)
 {
-    dSP;
+    djSP;
     HE* he;
+    SV **svp;
     SV *keysv = POPs;
     HV *hv = (HV*)POPs;
     U32 lval = op->op_flags & OPf_MOD;
     U32 defer = op->op_private & OPpLVAL_DEFER;
 
-    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;
-    he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+    }
     if (lval) {
-	if (!he || HeVAL(he) == &sv_undef) {
+	if (!svp || *svp == &sv_undef) {
 	    SV* lv;
 	    SV* key2;
 	    if (!defer)
@@ -1230,22 +1307,22 @@ PP(pp_helem)
 	    RETURN;
 	}
 	if (op->op_private & OPpLVAL_INTRO) {
-	    if (HvNAME(hv) && isGV(HeVAL(he)))
-		save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
+	    if (HvNAME(hv) && isGV(*svp))
+		save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
 	    else
-		save_svref(&HeVAL(he));
+		save_helem(hv, keysv, svp);
 	}
 	else if (op->op_private & OPpDEREF)
-	    vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
+	    vivify_ref(*svp, op->op_private & OPpDEREF);
     }
-    PUSHs(he ? HeVAL(he) : &sv_undef);
+    PUSHs(svp ? *svp : &sv_undef);
     RETURN;
 }
 
 PP(pp_leave)
 {
-    dSP;
-    register CONTEXT *cx;
+    djSP;
+    register PERL_CONTEXT *cx;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -1300,12 +1377,12 @@ PP(pp_leave)
 
 PP(pp_iter)
 {
-    dSP;
-    register CONTEXT *cx;
+    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");
@@ -1316,7 +1393,9 @@ PP(pp_iter)
 
     SvREFCNT_dec(*cx->blk_loop.itervar);
 
-    if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
+    if (sv = (SvMAGICAL(av)) 
+	    ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
+	    : AvARRAY(av)[++cx->blk_loop.iterix])
 	SvTEMP_off(sv);
     else
 	sv = &sv_undef;
@@ -1336,7 +1415,7 @@ PP(pp_iter)
 	}
 	LvTARG(lv) = SvREFCNT_inc(av);
 	LvTARGOFF(lv) = cx->blk_loop.iterix;
-	LvTARGLEN(lv) = -1;
+	LvTARGLEN(lv) = (UV) -1;
 	sv = (SV*)lv;
     }
 
@@ -1346,7 +1425,7 @@ PP(pp_iter)
 
 PP(pp_subst)
 {
-    dSP; dTARG;
+    djSP; dTARG;
     register PMOP *pm = cPMOP;
     PMOP *rpm = pm;
     register SV *dstr;
@@ -1367,19 +1446,23 @@ PP(pp_subst)
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = 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)
 	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) || SvTYPE(TARG) == SVt_PVGV)
 	force_on_match = 1;
@@ -1396,41 +1479,52 @@ PP(pp_subst)
 	pm = curpm;
 	rx = pm->op_pmregexp;
     }
-    safebase = (!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)))
 		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
-		|| (pm->op_pmslen > 1
-		    && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
+	/* 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;
 	}
     }
 
@@ -1441,9 +1535,10 @@ PP(pp_subst)
     c = dstr ? SvPV(dstr, clen) : Nullch;
 
     /* can do inplace substitution? */
-    if (c && clen <= rx->minlen && safebase) {
-	if (! pregexec(rx, s, strend, orig, 0,
-		       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
+    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;
@@ -1457,9 +1552,14 @@ PP(pp_subst)
 	curpm = pm;
 	SvSCREAM_off(TARG);	/* disable possible screamer */
 	if (once) {
-	    rxtainted = rx->exec_tainted;
-	    m = rx->startp[0];
-	    d = rx->endp[0];
+	    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) {
@@ -1494,6 +1594,7 @@ PP(pp_subst)
 		sv_chop(TARG, d);
 	    }
 	    TAINT_IF(rxtainted);
+	    SPAGAIN;
 	    PUSHs(&sv_yes);
 	}
 	else {
@@ -1501,7 +1602,7 @@ PP(pp_subst)
 	    do {
 		if (iters++ > maxiters)
 		    DIE("Substitution loop");
-		rxtainted |= rx->exec_tainted;
+		rxtainted |= RX_MATCH_TAINTED(rx);
 		m = rx->startp[0];
 		/*SUPPRESS 560*/
 		if (i = m - s) {
@@ -1514,43 +1615,48 @@ PP(pp_subst)
 		    d += clen;
 		}
 		s = rx->endp[0];
-	    } while (pregexec(rx, s, strend, orig, s == m,
-			      Nullsv, TRUE)); /* don't match same null twice */
+	    } 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 */
 	    }
 	    TAINT_IF(rxtainted);
+	    SPAGAIN;
 	    PUSHs(sv_2mortal(newSViv((I32)iters)));
 	}
 	(void)SvPOK_only(TARG);
-	SvSETMAGIC(TARG);
+	if (SvSMAGICAL(TARG)) {
+	    PUTBACK;
+	    mg_set(TARG);
+	    SPAGAIN;
+	}
 	SvTAINT(TARG);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
 
-    if (pregexec(rx, s, strend, orig, 0,
-		 SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
+    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;
 	}
-	rxtainted = rx->exec_tainted;
-	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->exec_tainted;
+	    rxtainted |= RX_MATCH_TAINTED(rx);
 	    if (rx->subbase && rx->subbase != orig) {
 		m = s;
 		s = orig;
@@ -1565,7 +1671,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);
 
 	TAINT_IF(rxtainted);
@@ -1581,6 +1687,7 @@ PP(pp_subst)
 	(void)SvPOK_only(TARG);
 	SvSETMAGIC(TARG);
 	SvTAINT(TARG);
+	SPAGAIN;
 	PUSHs(sv_2mortal(newSViv((I32)iters)));
 	LEAVE_SCOPE(oldsave);
 	RETURN;
@@ -1588,9 +1695,10 @@ PP(pp_subst)
     goto ret_no;
 
 nope:
-    ++BmUSEFUL(pm->op_pmshort);
+    ++BmUSEFUL(rx->check_substr);
 
-ret_no:
+ret_no:         
+    SPAGAIN;
     PUSHs(&sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
@@ -1598,7 +1706,7 @@ ret_no:
 
 PP(pp_grepwhile)
 {
-    dSP;
+    djSP;
 
     if (SvTRUEx(POPs))
 	stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
@@ -1606,7 +1714,7 @@ 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;
 
@@ -1631,7 +1739,7 @@ PP(pp_grepwhile)
 
 	src = stack_base[*markstack_ptr];
 	SvTEMP_off(src);
-	GvSV(defgv) = src;
+	DEFSV = src;
 
 	RETURNOP(cLOGOP->op_other);
     }
@@ -1639,12 +1747,12 @@ 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);
@@ -1678,13 +1786,41 @@ PP(pp_leavesub)
     return pop_return();
 }
 
+STATIC CV *
+get_db_sub(SV **svp, CV *cv)
+{
+    dTHR;
+    SV *oldsv = *svp;
+    GV *gv;
+
+    *svp = GvSV(DBsub);
+    save_item(*svp);
+    gv = CvGV(cv);
+    if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+	 || strEQ(GvNAME(gv), "END") 
+	 || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+	     !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
+    		&& (gv = (GV*)oldsv) ))) {
+	/* Use GV from the stack as a fallback. */
+	/* GV is potentially non-unique, or contain different CV. */
+	sv_setsv(*svp, newRV((SV*)cv));
+    }
+    else {
+	gv_efullname3(*svp, gv, Nullch);
+    }
+    cv = GvCV(DBsub);
+    if (CvXSUB(cv))
+	curcopdb = curcop;
+    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;
 
@@ -1738,7 +1874,7 @@ PP(pp_entersub)
 
     if (!CvROOT(cv) && !CvXSUB(cv)) {
 	GV* autogv;
-	SV* subname;
+	SV* sub_name;
 
 	/* anonymous or undef'd function leaves us no recourse */
 	if (CvANON(cv) || !(gv = CvGV(cv)))
@@ -1756,33 +1892,145 @@ PP(pp_entersub)
 	    goto retry;
 	}
 	/* sorry */
-	subname = sv_newmortal();
-	gv_efullname3(subname, gv, Nullch);
-	DIE("Undefined subroutine &%s called", SvPVX(subname));
+	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)) {
-	SV *oldsv = sv;
-	sv = GvSV(DBsub);
-	save_item(sv);
-	gv = CvGV(cv);
-	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-	     || strEQ(GvNAME(gv), "END") 
-	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
-		 !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
-		    && (gv = (GV*)oldsv) ))) { /* Use GV from the stack as a fallback. */
-	    /* GV is potentially non-unique, or contain different CV. */
-	    sv_setsv(sv, newRV((SV*)cv));
+    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 (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));
+	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;
+	
+	/*
+	 * 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(thr->cvcache, (char *)cv, sizeof(cv), FALSE);
+     	if (svp) {
+	    /* 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 {
-	    gv_efullname3(sv, gv, Nullch);
+	    /* (2) => grab ownership of cv. (3) => make clone */
+	    if (!CvOWNER(cv)) {
+		CvOWNER(cv) = thr;
+		SvREFCNT_inc(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);
 	}
-	cv = GvCV(DBsub);
-	if (CvXSUB(cv)) curcopdb = curcop;
-	if (!cv)
-	    DIE("No DBsub routine");
     }
+#endif /* USE_THREADS */
 
     if (CvXSUB(cv)) {
 	if (CvOLDSTYLE(cv)) {
@@ -1790,9 +2038,9 @@ PP(pp_entersub)
 	    dMARK;
 	    register I32 items = SP - MARK;
 					/* We dont worry to copy from @_. */
-	    while (sp > mark) {
-		sp[1] = sp[0];
-		sp--;
+	    while (SP > mark) {
+		SP[1] = SP[0];
+		SP--;
 	    }
 	    stack_sp = mark + 1;
 	    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
@@ -1810,14 +2058,20 @@ PP(pp_entersub)
 		/* 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 = GvAV(defgv);
-		I32 items = AvFILL(av) + 1;
+		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;
+		    EXTEND(SP, items);
+		    Copy(AvARRAY(av), SP + 1, items, SV*);
+		    SP += items;
 		    PUTBACK ;		    
 		}
 	    }
@@ -1829,7 +2083,7 @@ PP(pp_entersub)
 		curcopdb = NULL;
 	    }
 	    /* Do we need to open block here? XXXX */
-	    (void)(*CvXSUB(cv))(cv);
+	    (void)(*CvXSUB(cv))(THIS_ cv);
 
 	    /* Enforce some sanity in scalar context. */
 	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
@@ -1858,11 +2112,11 @@ PP(pp_entersub)
 	    if (CvDEPTH(cv) == 100 && dowarn 
 		  && !(PERLDB_SUB && cv == GvCV(DBsub)))
 		sub_crush_depth(cv);
-	    if (CvDEPTH(cv) > AvFILL(padlist)) {
+	    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) {
@@ -1892,23 +2146,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);
-	    cx->blk_sub.argarray = av;
 	    GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+	    cx->blk_sub.argarray = av;
 	    ++MARK;
 
 	    if (items > AvMAX(av) + 1) {
@@ -1925,7 +2203,7 @@ PP(pp_entersub)
 		}
 	    }
 	    Copy(MARK,AvARRAY(av),items,SV*);
-	    AvFILL(av) = items - 1;
+	    AvFILLp(av) = items - 1;
 	    
 	    while (items--) {
 		if (*MARK)
@@ -1933,13 +2211,16 @@ 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* cv;
+sub_crush_depth(CV *cv)
 {
     if (CvANON(cv))
 	warn("Deep recursion on anonymous subroutine");
@@ -1952,7 +2233,7 @@ CV* cv;
 
 PP(pp_aelem)
 {
-    dSP;
+    djSP;
     SV** svp;
     I32 elem = POPi;
     AV* av = (AV*)POPs;
@@ -1980,7 +2261,7 @@ PP(pp_aelem)
 	    RETURN;
 	}
 	if (op->op_private & OPpLVAL_INTRO)
-	    save_svref(svp);
+	    save_aelem(av, elem, svp);
 	else if (op->op_private & OPpDEREF)
 	    vivify_ref(*svp, op->op_private & OPpDEREF);
     }
@@ -1989,9 +2270,7 @@ PP(pp_aelem)
 }
 
 void
-vivify_ref(sv, to_what)
-SV* sv;
-U32 to_what;
+vivify_ref(SV *sv, U32 to_what)
 {
     if (SvGMAGICAL(sv))
 	mg_get(sv);
@@ -2007,7 +2286,7 @@ U32 to_what;
 	}
 	switch (to_what) {
 	case OPpDEREF_SV:
-	    SvRV(sv) = newSV(0);
+	    SvRV(sv) = NEWSV(355,0);
 	    break;
 	case OPpDEREF_AV:
 	    SvRV(sv) = (SV*)newAV();
@@ -2023,7 +2302,7 @@ U32 to_what;
 
 PP(pp_method)
 {
-    dSP;
+    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
@@ -2096,3 +2375,4 @@ PP(pp_method)
     SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
     RETURN;
 }
+