X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=7cc86558f218a8587b5d02c9d1a4fc85f6601199;hb=ba7b5225a182490f0fddd225ae43578870f30c47;hp=40432e0ae285730c231d4365bf2901229a83e22d;hpb=28757baaaeaa3801dd997fad8b1f5f62c64a228e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 40432e0..7cc8655 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.
@@ -160,8 +160,7 @@ PP(pp_sassign)
     }
     if (tainting && tainted && !SvTAINTED(left))
 	TAINT_NOT;
-    SvSetSV(right, left);
-    SvSETMAGIC(right);
+    SvSetMagicSV(right, left);
     SETs(right);
     RETURN;
 }
@@ -204,7 +203,10 @@ PP(pp_concat)
 	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;
   }
@@ -218,7 +220,7 @@ PP(pp_padsv)
 	if (op->op_private & OPpLVAL_INTRO)
 	    SAVECLEARSV(curpad[op->op_targ]);
         else if (op->op_private & OPpDEREF)
-	    provide_ref(op, curpad[op->op_targ]);
+	    vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
     }
     RETURN;
 }
@@ -234,7 +236,7 @@ PP(pp_eq)
     dSP; tryAMAGICbinSET(eq,0); 
     {
       dPOPnv;
-      SETs((TOPn == value) ? &sv_yes : &sv_no);
+      SETs(boolSV(TOPn == value));
       RETURN;
     }
 }
@@ -242,6 +244,8 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+	croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MAX)
     {
@@ -297,7 +301,19 @@ PP(pp_join)
 PP(pp_pushre)
 {
     dSP;
+#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;
 }
 
@@ -316,17 +332,22 @@ PP(pp_print)
     else
 	gv = defoutgv;
     if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
-	SV *sv;
-
-	PUSHMARK(MARK-1);
+	if (MARK == ORIGMARK) {
+	    EXTEND(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;
-	sv = POPs;
-	SP = ORIGMARK;
-	PUSHs(sv);
+	MARK = ORIGMARK + 1;
+	*MARK = *SP;
+	SP = MARK;
 	RETURN;
     }
     if (!(io = GvIO(gv))) {
@@ -398,7 +419,6 @@ PP(pp_print)
 PP(pp_rv2av)
 {
     dSP; dPOPss;
-
     AV *av;
 
     if (SvROK(sv)) {
@@ -436,6 +456,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;
@@ -473,9 +495,7 @@ PP(pp_rv2av)
 
 PP(pp_rv2hv)
 {
-
     dSP; dTOPss;
-
     HV *hv;
 
     if (SvROK(sv)) {
@@ -513,6 +533,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;
@@ -543,7 +565,7 @@ PP(pp_rv2hv)
     else {
 	dTARGET;
 	if (HvFILL(hv)) {
-	    sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
+	    sprintf(buf, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv)+1);
 	    sv_setpv(TARG, buf);
 	}
 	else
@@ -567,6 +589,7 @@ PP(pp_aassign)
     register SV *sv;
     register AV *ary;
 
+    I32 gimme;
     HV *hash;
     I32 i;
     int magic;
@@ -598,6 +621,7 @@ 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 = NEWSV(28,0);
@@ -720,7 +744,16 @@ PP(pp_aassign)
 	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
@@ -728,15 +761,8 @@ PP(pp_aassign)
 	lelem = firstlelem + (relem - firstrelem);
 	while (relem <= SP)
 	    *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef;
-	RETURN;
-    }
-    else {
-	dTARGET;
-	SP = firstrelem;
-		
-	SETi(lastrelem - firstrelem + 1);
-	RETURN;
     }
+    RETURN;
 }
 
 PP(pp_match)
@@ -754,6 +780,7 @@ PP(pp_match)
     STRLEN len;
     I32 minmatch = 0;
     I32 oldsave = savestack_ix;
+    I32 update_minmatch = 1;
 
     if (op->op_flags & OPf_STACKED)
 	TARG = POPs;
@@ -765,6 +792,7 @@ PP(pp_match)
     strend = s + len;
     if (!s)
 	DIE("panic: do_match");
+    TAINT_NOT;
 
     if (pm->op_pmflags & PMf_USED) {
 	if (gimme == G_ARRAY)
@@ -784,12 +812,14 @@ 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) && !sawampersand);
+    safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
+		&& !sawampersand);
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
 	SAVEINT(multiline);
 	multiline = pm->op_pmflags & PMf_MULTILINE;
@@ -798,9 +828,10 @@ 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) {
@@ -850,10 +881,10 @@ play_it_again:
     /*NOTREACHED*/
 
   gotcha:
+    TAINT_IF(rx->exec_tainted);
     if (gimme == G_ARRAY) {
 	I32 iters, i, len;
 
-	TAINT_IF(rx->exec_tainted);
 	iters = rx->nparens;
 	if (global && !iters)
 	    i = 1;
@@ -901,6 +932,7 @@ play_it_again:
     }
 
 yup:
+    TAINT_IF(rx->exec_tainted);
     ++BmUSEFUL(pm->op_pmshort);
     curpm = pm;
     if (pm->op_pmflags & PMf_ONCE)
@@ -947,6 +979,7 @@ do_readline()
     PerlIO *fp;
     register IO *io = GvIO(last_in_gv);
     register I32 type = op->op_type;
+    I32 gimme = GIMME_V;
     MAGIC *mg;
 
     if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
@@ -954,11 +987,11 @@ do_readline()
 	XPUSHs(mg->mg_obj);
 	PUTBACK;
 	ENTER;
-	perl_call_method("READLINE", GIMME);
+	perl_call_method("READLINE", gimme);
 	LEAVE;
 	SPAGAIN;
-	if (GIMME == G_SCALAR)
-	    SvSetSV_nosteal(TARG, TOPs);
+	if (gimme == G_SCALAR)
+	    SvSetMagicSV_nosteal(TARG, TOPs);
 	RETURN;
     }
     fp = Nullfp;
@@ -1037,7 +1070,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 {
@@ -1061,6 +1094,7 @@ do_readline()
 		           PerlIO_rewind(tmpfp);
 		           IoTYPE(io) = '<';
 		           IoIFP(io) = fp = tmpfp;
+		           IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
 		        }
 		    }
 		}
@@ -1104,18 +1138,16 @@ 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 {
+    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)
@@ -1125,6 +1157,10 @@ do_readline()
 	else
 	    offset = 0;
     }
+    else {
+	sv = sv_2mortal(NEWSV(57, 80));
+	offset = 0;
+    }
     for (;;) {
 	if (!sv_gets(sv, fp, offset)) {
 	    PerlIO_clearerr(fp);
@@ -1136,9 +1172,10 @@ 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;
 	    }
@@ -1171,7 +1208,7 @@ do_readline()
 		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);
@@ -1179,7 +1216,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);
@@ -1195,19 +1232,14 @@ PP(pp_enter)
 {
     dSP;
     register CONTEXT *cx;
-    I32 gimme;
-
-    /*
-     * 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.
-     */
+    I32 gimme = OP_GIMME(op, -1);
 
-    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;
 
@@ -1223,14 +1255,28 @@ PP(pp_helem)
     HE* he;
     SV *keysv = POPs;
     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;
 
     if (SvTYPE(hv) != SVt_PVHV)
 	RETPUSHUNDEF;
-    he = hv_fetch_ent(hv, keysv, lval, 0);
+    he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
     if (lval) {
-	if (!he || HeVAL(he) == &sv_undef)
-	    DIE(no_helem, SvPV(keysv, na));
+	if (!he || HeVAL(he) == &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(HeVAL(he)))
 		save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
@@ -1238,7 +1284,7 @@ PP(pp_helem)
 		save_svref(&HeVAL(he));
 	}
 	else if (op->op_private & OPpDEREF)
-	    provide_ref(op, HeVAL(he));
+	    vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
     }
     PUSHs(he ? HeVAL(he) : &sv_undef);
     RETURN;
@@ -1260,31 +1306,30 @@ 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;
+    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 {
+    else if (gimme == G_ARRAY) {
 	for (mark = newsp + 1; mark <= SP; mark++)
 	    if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
 		*mark = sv_mortalcopy(*mark);
@@ -1328,14 +1373,14 @@ PP(pp_iter)
 	if (lv)
 	    SvREFCNT_dec(LvTARG(lv));
 	else {
-	    lv = cx->blk_loop.iterlval = newSVsv(sv);
+	    lv = cx->blk_loop.iterlval = NEWSV(26, 0);
 	    sv_upgrade(lv, SVt_PVLV);
-	    sv_magic(lv, Nullsv, 'y', Nullch, 0);
 	    LvTYPE(lv) = 'y';
+	    sv_magic(lv, Nullsv, 'y', Nullch, 0);
 	}
 	LvTARG(lv) = SvREFCNT_inc(av);
 	LvTARGOFF(lv) = cx->blk_loop.iterix;
-	LvTARGLEN(lv) = 1;
+	LvTARGLEN(lv) = -1;
 	sv = (SV*)lv;
     }
 
@@ -1367,17 +1412,22 @@ PP(pp_subst)
     int force_on_match = 0;
     I32 oldsave = savestack_ix;
 
-    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);
 	EXTEND(SP,1);
     }
+    if (SvREADONLY(TARG)
+	|| (SvTYPE(TARG) > SVt_PVLV
+	    && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
+	croak(no_modify);
     s = SvPV(TARG, len);
-    if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
+    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
 	force_on_match = 1;
+    TAINT_NOT;
 
   force_it:
     if (!pm || !s)
@@ -1432,10 +1482,10 @@ PP(pp_subst)
     once = !(rpm->op_pmflags & PMf_GLOBAL);
 
     /* known replacement string? */
-    c = (rpm->op_pmflags & PMf_CONST) ? SvPV(dstr, clen) : Nullch;
+    c = dstr ? SvPV(dstr, clen) : Nullch;
 
     /* can do inplace substitution? */
-    if (c && clen <= rx->minlen) {
+    if (c && clen <= rx->minlen && safebase) {
 	if (! pregexec(rx, s, strend, orig, 0,
 		       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
 	    PUSHs(&sv_no);
@@ -1447,8 +1497,6 @@ PP(pp_subst)
 	    s = SvPV_force(TARG, len);
 	    goto force_it;
 	}
-	if (rx->subbase) 	/* oops, no we can't */
-	    goto long_way;
 	d = s;
 	curpm = pm;
 	SvSCREAM_off(TARG);	/* disable possible screamer */
@@ -1489,6 +1537,7 @@ PP(pp_subst)
 	    else {
 		sv_chop(TARG, d);
 	    }
+	    TAINT_IF(rxtainted);
 	    PUSHs(&sv_yes);
 	}
 	else {
@@ -1516,19 +1565,18 @@ PP(pp_subst)
 		SvCUR_set(TARG, d - SvPVX(TARG) + i);
 		Move(s, d, i+1, char);		/* include the NUL */
 	    }
+	    TAINT_IF(rxtainted);
 	    PUSHs(sv_2mortal(newSViv((I32)iters)));
 	}
 	(void)SvPOK_only(TARG);
 	SvSETMAGIC(TARG);
-	if (rxtainted)
-	    SvTAINTED_on(TARG);
+	SvTAINT(TARG);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
 
     if (pregexec(rx, s, strend, orig, 0,
 		 SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
-    long_way:
 	if (force_on_match) {
 	    force_on_match = 0;
 	    s = SvPV_force(TARG, len);
@@ -1564,6 +1612,8 @@ PP(pp_subst)
 	} while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase));
 	sv_catpvn(dstr, s, strend - s);
 
+	TAINT_IF(rxtainted);
+
 	(void)SvOOK_off(TARG);
 	Safefree(SvPVX(TARG));
 	SvPVX(TARG) = SvPVX(dstr);
@@ -1574,18 +1624,17 @@ PP(pp_subst)
 
 	(void)SvPOK_only(TARG);
 	SvSETMAGIC(TARG);
-	if (rxtainted)
-	    SvTAINTED_on(TARG);
+	SvTAINT(TARG);
 	PUSHs(sv_2mortal(newSViv((I32)iters)));
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
-    PUSHs(&sv_no);
-    LEAVE_SCOPE(oldsave);
-    RETURN;
+    goto ret_no;
 
 nope:
     ++BmUSEFUL(pm->op_pmshort);
+
+ret_no:
     PUSHs(&sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
@@ -1603,18 +1652,19 @@ PP(pp_grepwhile)
     /* All done yet? */
     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 {
@@ -1639,40 +1689,33 @@ PP(pp_leavesub)
     PMOP *newpm;
     I32 gimme;
     register CONTEXT *cx;
+    struct block_sub cxsub;
 
     POPBLOCK(cx,newpm);
-    POPSUB(cx);
-
+    POPSUB1(cx);	/* Delay POPSUB2 until stack values are safe */
+ 
     if (gimme == G_SCALAR) {
 	MARK = newsp + 1;
 	if (MARK <= SP)
-	    if (SvFLAGS(TOPs) & SVs_TEMP)
-		*MARK = TOPs;
-	    else
-		*MARK = sv_mortalcopy(TOPs);
+	    *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
 	else {
-	    MEXTEND(mark,0);
+	    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 */
-    }
-
-    if (cx->blk_sub.hasargs) {		/* You don't exist; go away. */
-	AV* av = cx->blk_sub.argarray;
-
-	av_clear(av);
-	AvREAL_off(av);
+    else if (gimme == G_ARRAY) {
+	for (MARK = newsp + 1; MARK <= SP; MARK++) {
+	    if (!SvTEMP(*MARK))
+		*MARK = sv_mortalcopy(*MARK);
+	}
     }
-    curpm = newpm;	/* Don't pop $1 et al till now */
+    PUTBACK;
+    
+    POPSUB2();		/* Stack values are safe: release CV and @_ ... */
+    curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
-    PUTBACK;
     return pop_return();
 }
 
@@ -1695,9 +1738,14 @@ PP(pp_entersub)
 
 	    if (sv == &sv_yes)		/* unfound import, ignore */
 		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);
@@ -1727,29 +1775,31 @@ PP(pp_entersub)
 	DIE("Not a CODE reference");
 
     if (!CvROOT(cv) && !CvXSUB(cv)) {
-	if (gv = CvGV(cv)) {
-	    SV *tmpstr;
-	    GV *ngv;
-	    if (cv != GvCV(gv)) {	/* autoloaded stub? */
-		cv = GvCV(gv);
-		goto retry;
-	    }
-	    tmpstr = sv_newmortal();
-	    gv_efullname3(tmpstr, gv, Nullch);
-	    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 */
-		SvTAINTED_off(GvSV(CvGV(cv)));
-		goto retry;
-	    }
-	    else
-		DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
+	GV* autogv;
+	SV* subname;
+
+	/* 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;
+	}
+	/* should call AUTOLOAD now? */
+	if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+				   FALSE)))
+	{
+	    cv = GvCV(autogv);
+	    goto retry;
 	}
-	DIE("Undefined subroutine called");
+	/* sorry */
+	subname = sv_newmortal();
+	gv_efullname3(subname, gv, Nullch);
+	DIE("Undefined subroutine &%s called", SvPVX(subname));
     }
 
-    gimme = GIMME;
+    gimme = GIMME_V;
     if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) {
 	SV *oldsv = sv;
 	sv = GvSV(DBsub);
@@ -1844,8 +1894,8 @@ PP(pp_entersub)
 	    (void)SvREFCNT_inc(cv);
 	else {	/* save temporaries on recursion? */
 	    if (CvDEPTH(cv) == 100 && dowarn 
-		&& !(perldb && cv == GvCV(DBsub)))
-		warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
+		  && !(perldb && cv == GvCV(DBsub)))
+		sub_crush_depth(cv);
 	    if (CvDEPTH(cv) > AvFILL(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
@@ -1925,35 +1975,61 @@ PP(pp_entersub)
     }
 }
 
+void
+sub_crush_depth(cv)
+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;
     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));
 
     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)
-	    provide_ref(op, *svp);
+	    vivify_ref(*svp, op->op_private & OPpDEREF);
     }
     PUSHs(svp ? *svp : &sv_undef);
     RETURN;
 }
 
 void
-provide_ref(op, sv)
-OP* op;
+vivify_ref(sv, to_what)
 SV* sv;
+U32 to_what;
 {
     if (SvGMAGICAL(sv))
 	mg_get(sv);
@@ -1967,8 +2043,7 @@ SV* sv;
 	    Safefree(SvPVX(sv));
 	    SvLEN(sv) = SvCUR(sv) = 0;
 	}
-	switch (op->op_private & OPpDEREF)
-	{
+	switch (to_what) {
 	case OPpDEREF_SV:
 	    SvRV(sv) = newSV(0);
 	    break;
@@ -1990,61 +2065,64 @@ PP(pp_method)
     SV* sv;
     SV* ob;
     GV* gv;
-    SV* nm;
+    HV* stash;
+    char* name;
+    char* packname;
+    STRLEN packlen;
 
-    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;
-	STRLEN packlen;
 
+	packname = Nullch;
 	if (!SvOK(sv) ||
 	    !(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_stashpvn(packname, packlen, FALSE))) {
-		if (gv_stashpvn("UNIVERSAL", 9, FALSE))
-		    stash = gv_stashpvn(packname, packlen, 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(isGV(gv) ? (SV*)GvCV(gv) : (SV*)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((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;
+
+	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;
 }
-