X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=3cda64411389d6b7700d57aa185229b6050c4bdc;hb=374f98998144a5e58919ddd781cb75f885e750f6;hp=d71544744928e848d882e2b2fe110c4e5d4aa767;hpb=e982885c7ba24a5bfd453c5e627281408fc80421;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index d715447..3cda644 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -47,7 +47,7 @@ static I32 sv_cmp_locale_static(pTHXo_ SV *a, SV *b);
 
 PP(pp_wantarray)
 {
-    djSP;
+    dSP;
     I32 cxix;
     EXTEND(SP, 1);
 
@@ -80,7 +80,7 @@ PP(pp_regcreset)
 
 PP(pp_regcomp)
 {
-    djSP;
+    dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     register char *t;
     SV *tmpstr;
@@ -156,7 +156,7 @@ PP(pp_regcomp)
 
 PP(pp_substcont)
 {
-    djSP;
+    dSP;
     register PMOP *pm = (PMOP*) cLOGOP->op_other;
     register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
     register SV *dstr = cx->sb_dstr;
@@ -164,7 +164,7 @@ PP(pp_substcont)
     register char *m = cx->sb_m;
     char *orig = cx->sb_orig;
     register REGEXP *rx = cx->sb_rx;
-    
+
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
@@ -304,7 +304,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 
 PP(pp_formline)
 {
-    djSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     register SV *tmpForm = *++MARK;
     register U16 *fpc;
     register char *t;
@@ -551,7 +551,13 @@ PP(pp_formline)
 	    if (item_is_utf) {
 		while (arg--) {
 		    if (UTF8_IS_CONTINUED(*s)) {
-			switch (UTF8SKIP(s)) {
+			STRLEN skip = UTF8SKIP(s);
+			switch (skip) {
+			default:
+			    Move(s,t,skip,char);
+			    s += skip;
+			    t += skip;
+			    break;
 			case 7: *t++ = *s++;
 			case 6: *t++ = *s++;
 			case 5: *t++ = *s++;
@@ -750,7 +756,7 @@ PP(pp_formline)
 
 PP(pp_grepstart)
 {
-    djSP;
+    dSP;
     SV *src;
 
     if (PL_stack_base + *PL_markstack_ptr == SP) {
@@ -787,7 +793,7 @@ PP(pp_mapstart)
 
 PP(pp_mapwhile)
 {
-    djSP;
+    dSP;
     I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
     I32 count;
     I32 shift;
@@ -875,7 +881,7 @@ PP(pp_mapwhile)
 
 PP(pp_sort)
 {
-    djSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     register SV **up;
     SV **myorigmark = ORIGMARK;
     register I32 max;
@@ -1060,7 +1066,7 @@ PP(pp_range)
 
 PP(pp_flip)
 {
-    djSP;
+    dSP;
 
     if (GIMME == G_ARRAY) {
 	RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
@@ -1099,7 +1105,7 @@ PP(pp_flip)
 
 PP(pp_flop)
 {
-    djSP;
+    dSP;
 
     if (GIMME == G_ARRAY) {
 	dPOPPOPssrl;
@@ -1380,41 +1386,6 @@ Perl_dounwind(pTHX_ I32 cxix)
     }
 }
 
-/*
- * Closures mentioned at top level of eval cannot be referenced
- * again, and their presence indirectly causes a memory leak.
- * (Note that the fact that compcv and friends are still set here
- * is, AFAIK, an accident.)  --Chip
- *
- * XXX need to get comppad et al from eval's cv rather than
- * relying on the incidental global values.
- */
-STATIC void
-S_free_closures(pTHX)
-{
-    SV **svp = AvARRAY(PL_comppad_name);
-    I32 ix;
-    for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
-	SV *sv = svp[ix];
-	if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
-	    SvREFCNT_dec(sv);
-	    svp[ix] = &PL_sv_undef;
-
-	    sv = PL_curpad[ix];
-	    if (CvCLONE(sv)) {
-		SvREFCNT_dec(CvOUTSIDE(sv));
-		CvOUTSIDE(sv) = Nullcv;
-	    }
-	    else {
-		SvREFCNT_dec(sv);
-		sv = NEWSV(0,0);
-		SvPADTMP_on(sv);
-		PL_curpad[ix] = sv;
-	    }
-	}
-    }
-}
-
 void
 Perl_qerror(pTHX_ SV *err)
 {
@@ -1534,7 +1505,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
 PP(pp_xor)
 {
-    djSP; dPOPTOPssrl;
+    dSP; dPOPTOPssrl;
     if (SvTRUE(left) != SvTRUE(right))
 	RETSETYES;
     else
@@ -1543,7 +1514,7 @@ PP(pp_xor)
 
 PP(pp_andassign)
 {
-    djSP;
+    dSP;
     if (!SvTRUE(TOPs))
 	RETURN;
     else
@@ -1552,7 +1523,7 @@ PP(pp_andassign)
 
 PP(pp_orassign)
 {
-    djSP;
+    dSP;
     if (SvTRUE(TOPs))
 	RETURN;
     else
@@ -1561,7 +1532,7 @@ PP(pp_orassign)
 	
 PP(pp_caller)
 {
-    djSP;
+    dSP;
     register I32 cxix = dopoptosub(cxstack_ix);
     register PERL_CONTEXT *cx;
     register PERL_CONTEXT *ccstack = cxstack;
@@ -1704,7 +1675,7 @@ PP(pp_caller)
 
 PP(pp_reset)
 {
-    djSP;
+    dSP;
     char *tmps;
     STRLEN n_a;
 
@@ -1731,7 +1702,7 @@ PP(pp_dbstate)
 
     if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
-	djSP;
+	dSP;
 	register CV *cv;
 	register PERL_CONTEXT *cx;
 	I32 gimme = G_ARRAY;
@@ -1743,7 +1714,8 @@ PP(pp_dbstate)
 	if (!cv)
 	    DIE(aTHX_ "No DB::DB routine defined");
 
-	if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */
+	if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG))
+	    /* don't do recursive DB::DB call */
 	    return NORMAL;
 
 	ENTER;
@@ -1775,7 +1747,7 @@ PP(pp_scope)
 
 PP(pp_enteriter)
 {
-    djSP; dMARK;
+    dSP; dMARK;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
     SV **svp;
@@ -1854,7 +1826,7 @@ PP(pp_enteriter)
 
 PP(pp_enterloop)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -1870,7 +1842,7 @@ PP(pp_enterloop)
 
 PP(pp_leaveloop)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -1910,7 +1882,7 @@ PP(pp_leaveloop)
 
 PP(pp_return)
 {
-    djSP; dMARK;
+    dSP; dMARK;
     I32 cxix;
     register PERL_CONTEXT *cx;
     bool popsub2 = FALSE;
@@ -1950,8 +1922,6 @@ PP(pp_return)
 	POPEVAL(cx);
 	if (CxTRYBLOCK(cx))
 	    break;
-	if (AvFILLp(PL_comppad_name) >= 0)
-	    free_closures();
 	lex_end();
 	if (optype == OP_REQUIRE &&
 	    (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
@@ -2021,7 +1991,7 @@ PP(pp_return)
 
 PP(pp_last)
 {
-    djSP;
+    dSP;
     I32 cxix;
     register PERL_CONTEXT *cx;
     I32 pop2 = 0;
@@ -2208,7 +2178,7 @@ PP(pp_dump)
 
 PP(pp_goto)
 {
-    djSP;
+    dSP;
     OP *retop = 0;
     I32 ix;
     register PERL_CONTEXT *cx;
@@ -2259,7 +2229,7 @@ PP(pp_goto)
 	    if (cxix < cxstack_ix)
 		dounwind(cxix);
 	    TOPBLOCK(cx);
-	    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
+	    if (CxREALEVAL(cx))
 		DIE(aTHX_ "Can't goto subroutine from an eval-string");
 	    mark = PL_stack_sp;
 	    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
@@ -2490,6 +2460,8 @@ PP(pp_goto)
 
     if (label && *label) {
 	OP *gotoprobe = 0;
+	bool leaving_eval = FALSE;
+        PERL_CONTEXT *last_eval_cx = 0;
 
 	/* find label */
 
@@ -2499,8 +2471,15 @@ PP(pp_goto)
 	    cx = &cxstack[ix];
 	    switch (CxTYPE(cx)) {
 	    case CXt_EVAL:
-		gotoprobe = PL_eval_root; /* XXX not good for nested eval */
-		break;
+		leaving_eval = TRUE;
+                if (CxREALEVAL(cx)) {
+		    gotoprobe = (last_eval_cx ?
+				last_eval_cx->blk_eval.old_eval_root :
+				PL_eval_root);
+		    last_eval_cx = cx;
+		    break;
+                }
+                /* else fall through */
 	    case CXt_LOOP:
 		gotoprobe = cx->blk_oldcop->op_sibling;
 		break;
@@ -2538,6 +2517,17 @@ PP(pp_goto)
 	if (!retop)
 	    DIE(aTHX_ "Can't find label %s", label);
 
+	/* if we're leaving an eval, check before we pop any frames
+           that we're not going to punt, otherwise the error
+	   won't be caught */
+
+	if (leaving_eval && *enterops && enterops[1]) {
+	    I32 i;
+            for (i = 1; enterops[i]; i++)
+                if (enterops[i]->op_type == OP_ENTERITER)
+                    DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+	}
+
 	/* pop unwanted frames */
 
 	if (ix < cxstack_ix) {
@@ -2585,7 +2575,7 @@ PP(pp_goto)
 
 PP(pp_exit)
 {
-    djSP;
+    dSP;
     I32 anum;
 
     if (MAXARG < 1)
@@ -2606,7 +2596,7 @@ PP(pp_exit)
 #ifdef NOTYET
 PP(pp_nswitch)
 {
-    djSP;
+    dSP;
     NV value = SvNVx(GvSV(cCOP->cop_gv));
     register I32 match = I_32(value);
 
@@ -2625,7 +2615,7 @@ PP(pp_nswitch)
 
 PP(pp_cswitch)
 {
-    djSP;
+    dSP;
     register I32 match;
 
     if (PL_multiline)
@@ -2876,7 +2866,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
 	CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
     }
 
-    SAVEFREESV(PL_compcv);
+    SAVEMORTALIZESV(PL_compcv);	/* must remain until end of current statement */
 
     /* make sure we compile in the right package */
 
@@ -3024,7 +3014,7 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode)
 
 PP(pp_require)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     SV *sv;
     char *name;
@@ -3032,7 +3022,7 @@ PP(pp_require)
     char *tryname;
     SV *namesv = Nullsv;
     SV** svp;
-    I32 gimme = G_SCALAR;
+    I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     STRLEN n_a;
     int filter_has_file = 0;
@@ -3048,13 +3038,13 @@ PP(pp_require)
 	    U8 *s = (U8*)SvPVX(sv);
 	    U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
 	    if (s < end) {
-		rev = utf8_to_uv(s, end - s, &len, 0);
+		rev = utf8n_to_uvchr(s, end - s, &len, 0);
 		s += len;
 		if (s < end) {
-		    ver = utf8_to_uv(s, end - s, &len, 0);
+		    ver = utf8n_to_uvchr(s, end - s, &len, 0);
 		    s += len;
 		    if (s < end)
-			sver = utf8_to_uv(s, end - s, &len, 0);
+			sver = utf8n_to_uvchr(s, end - s, &len, 0);
 		}
 	    }
 	    if (PERL_REVISION < rev
@@ -3370,7 +3360,7 @@ trylocal: {
     PL_eval_owner = thr;
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_THREADS */
-    return DOCATCH(doeval(G_SCALAR, NULL));
+    return DOCATCH(doeval(gimme, NULL));
 }
 
 PP(pp_dofile)
@@ -3380,7 +3370,7 @@ PP(pp_dofile)
 
 PP(pp_entereval)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     dPOPss;
     I32 gimme = GIMME_V, was = PL_sub_generation;
@@ -3464,7 +3454,7 @@ PP(pp_entereval)
 
 PP(pp_leaveeval)
 {
-    djSP;
+    dSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -3506,9 +3496,6 @@ PP(pp_leaveeval)
     }
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
-    if (AvFILLp(PL_comppad_name) >= 0)
-	free_closures();
-
 #ifdef DEBUGGING
     assert(CvDEPTH(PL_compcv) == 1);
 #endif
@@ -3535,7 +3522,7 @@ PP(pp_leaveeval)
 
 PP(pp_entertry)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -3545,7 +3532,6 @@ PP(pp_entertry)
     push_return(cLOGOP->op_other->op_next);
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
     PUSHEVAL(cx, 0, 0);
-    PL_eval_root = PL_op;		/* Only needed so that goto works right. */
 
     PL_in_eval = EVAL_INEVAL;
     sv_setpv(ERRSV,"");
@@ -3555,7 +3541,7 @@ PP(pp_entertry)
 
 PP(pp_leavetry)
 {
-    djSP;
+    dSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -4401,7 +4387,7 @@ run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
     }
 
     if (filter_sub && len >= 0) {
-	djSP;
+	dSP;
 	int count;
 
 	ENTER;