X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e858de61083066071eb1526df39bdaa094032c61..2dac949e495b95e587bbb698cde49a859cbb8f89:/pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 2f3b2b7..36baae5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -42,7 +42,7 @@ static I32 sortcxix;
 
 PP(pp_wantarray)
 {
-    dSP;
+    djSP;
     I32 cxix;
     EXTEND(SP, 1);
 
@@ -66,7 +66,7 @@ PP(pp_regcmaybe)
 }
 
 PP(pp_regcomp) {
-    dSP;
+    djSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     register char *t;
     SV *tmpstr;
@@ -103,7 +103,7 @@ PP(pp_regcomp) {
 
 PP(pp_substcont)
 {
-    dSP;
+    djSP;
     register PMOP *pm = (PMOP*) cLOGOP->op_other;
     register CONTEXT *cx = &cxstack[cxstack_ix];
     register SV *dstr = cx->sb_dstr;
@@ -164,9 +164,7 @@ PP(pp_substcont)
 }
 
 void
-rxres_save(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_save(void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
@@ -194,9 +192,7 @@ REGEXP *rx;
 }
 
 void
-rxres_restore(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_restore(void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
@@ -216,8 +212,7 @@ REGEXP *rx;
 }
 
 void
-rxres_free(rsp)
-void **rsp;
+rxres_free(void **rsp)
 {
     UV *p = (UV*)*rsp;
 
@@ -230,7 +225,7 @@ void **rsp;
 
 PP(pp_formline)
 {
-    dSP; dMARK; dORIGMARK;
+    djSP; dMARK; dORIGMARK;
     register SV *form = *++MARK;
     register U16 *fpc;
     register char *t;
@@ -523,7 +518,7 @@ PP(pp_formline)
 
 PP(pp_grepstart)
 {
-    dSP;
+    djSP;
     SV *src;
 
     if (stack_base + *markstack_ptr == sp) {
@@ -560,7 +555,7 @@ PP(pp_mapstart)
 
 PP(pp_mapwhile)
 {
-    dSP;
+    djSP;
     I32 diff = (sp - stack_base) - *markstack_ptr;
     I32 count;
     I32 shift;
@@ -624,7 +619,7 @@ PP(pp_mapwhile)
 
 PP(pp_sort)
 {
-    dSP; dMARK; dORIGMARK;
+    djSP; dMARK; dORIGMARK;
     register SV **up;
     SV **myorigmark = ORIGMARK;
     register I32 max;
@@ -698,7 +693,7 @@ PP(pp_sort)
 	    bool oldcatch = CATCH_GET;
 
 	    SAVETMPS;
-	    SAVESPTR(op);
+	    SAVEOP();
 
 	    oldstack = curstack;
 	    if (!sortstack) {
@@ -724,7 +719,7 @@ PP(pp_sort)
 		cx->blk_gimme = G_SCALAR;
 		PUSHSUB(cx);
 		if (!CvDEPTH(cv))
-		    SvREFCNT_inc(cv);	/* in preparation for POPSUB */
+		    (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
 	    }
 	    sortcxix = cxstack_ix;
 
@@ -758,7 +753,7 @@ PP(pp_range)
 
 PP(pp_flip)
 {
-    dSP;
+    djSP;
 
     if (GIMME == G_ARRAY) {
 	RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
@@ -773,6 +768,7 @@ PP(pp_flip)
 	    sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
 	    if (op->op_flags & OPf_SPECIAL) {
 		sv_setiv(targ, 1);
+		SETs(targ);
 		RETURN;
 	    }
 	    else {
@@ -789,7 +785,7 @@ PP(pp_flip)
 
 PP(pp_flop)
 {
-    dSP;
+    djSP;
 
     if (GIMME == G_ARRAY) {
 	dPOPPOPssrl;
@@ -846,8 +842,7 @@ PP(pp_flop)
 /* Control. */
 
 static I32
-dopoptolabel(label)
-char *label;
+dopoptolabel(char *label)
 {
     dTHR;
     register I32 i;
@@ -887,14 +882,14 @@ char *label;
 }
 
 I32
-dowantarray()
+dowantarray(void)
 {
     I32 gimme = block_gimme();
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
 
 I32
-block_gimme()
+block_gimme(void)
 {
     dTHR;
     I32 cxix;
@@ -904,20 +899,19 @@ block_gimme()
 	return G_VOID;
 
     switch (cxstack[cxix].blk_gimme) {
-    case G_VOID:
-	return G_VOID;
     case G_SCALAR:
 	return G_SCALAR;
     case G_ARRAY:
 	return G_ARRAY;
     default:
 	croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
+    case G_VOID:
+	return G_VOID;
     }
 }
 
 static I32
-dopoptosub(startingblock)
-I32 startingblock;
+dopoptosub(I32 startingblock)
 {
     dTHR;
     I32 i;
@@ -937,8 +931,7 @@ I32 startingblock;
 }
 
 static I32
-dopoptoeval(startingblock)
-I32 startingblock;
+dopoptoeval(I32 startingblock)
 {
     dTHR;
     I32 i;
@@ -957,8 +950,7 @@ I32 startingblock;
 }
 
 static I32
-dopoptoloop(startingblock)
-I32 startingblock;
+dopoptoloop(I32 startingblock)
 {
     dTHR;
     I32 i;
@@ -991,8 +983,7 @@ I32 startingblock;
 }
 
 void
-dounwind(cxix)
-I32 cxix;
+dounwind(I32 cxix)
 {
     dTHR;
     register CONTEXT *cx;
@@ -1025,8 +1016,7 @@ I32 cxix;
 }
 
 OP *
-die_where(message)
-char *message;
+die_where(char *message)
 {
     dTHR;
     if (in_eval) {
@@ -1039,21 +1029,21 @@ char *message;
 	    SV **svp;
 	    STRLEN klen = strlen(message);
 	    
-	    svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+	    svp = hv_fetch(errhv, message, klen, TRUE);
 	    if (svp) {
 		if (!SvIOK(*svp)) {
 		    static char prefix[] = "\t(in cleanup) ";
 		    sv_upgrade(*svp, SVt_IV);
 		    (void)SvIOK_only(*svp);
-		    SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
-		    sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
-		    sv_catpvn(GvSV(errgv), message, klen);
+		    SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
+		    sv_catpvn(errsv, prefix, sizeof(prefix)-1);
+		    sv_catpvn(errsv, message, klen);
 		}
 		sv_inc(*svp);
 	    }
 	}
 	else
-	    sv_setpv(GvSV(errgv), message);
+	    sv_setpv(errsv, message);
 	
 	cxix = dopoptoeval(cxstack_ix);
 	if (cxix >= 0) {
@@ -1076,7 +1066,7 @@ char *message;
 	    LEAVE;
 
 	    if (optype == OP_REQUIRE) {
-		char* msg = SvPVx(GvSV(errgv), na);
+		char* msg = SvPV(errsv, na);
 		DIE("%s", *msg ? msg : "Compilation failed in require");
 	    }
 	    return pop_return();
@@ -1091,7 +1081,7 @@ char *message;
 
 PP(pp_xor)
 {
-    dSP; dPOPTOPssrl;
+    djSP; dPOPTOPssrl;
     if (SvTRUE(left) != SvTRUE(right))
 	RETSETYES;
     else
@@ -1100,7 +1090,7 @@ PP(pp_xor)
 
 PP(pp_andassign)
 {
-    dSP;
+    djSP;
     if (!SvTRUE(TOPs))
 	RETURN;
     else
@@ -1109,31 +1099,16 @@ PP(pp_andassign)
 
 PP(pp_orassign)
 {
-    dSP;
+    djSP;
     if (SvTRUE(TOPs))
 	RETURN;
     else
 	RETURNOP(cLOGOP->op_other);
 }
 	
-#ifdef DEPRECATED
-PP(pp_entersubr)
-{
-    dSP;
-    SV** mark = (stack_base + *markstack_ptr + 1);
-    SV* cv = *mark;
-    while (mark < sp) {	/* emulate old interface */
-	*mark = mark[1];
-	mark++;
-    }
-    *sp = cv;
-    return pp_entersub(ARGS);
-}
-#endif
-
 PP(pp_caller)
 {
-    dSP;
+    djSP;
     register I32 cxix = dopoptosub(cxstack_ix);
     register CONTEXT *cx;
     I32 dbcxix;
@@ -1229,9 +1204,7 @@ PP(pp_caller)
 }
 
 static int
-sortcv(a, b)
-const void *a;
-const void *b;
+sortcv(const void *a, const void *b)
 {
     dTHR;
     SV * const *str1 = (SV * const *)a;
@@ -1257,69 +1230,20 @@ const void *b;
 }
 
 static int
-sortcmp(a, b)
-const void *a;
-const void *b;
+sortcmp(const void *a, const void *b)
 {
     return sv_cmp(*(SV * const *)a, *(SV * const *)b);
 }
 
 static int
-sortcmp_locale(a, b)
-const void *a;
-const void *b;
+sortcmp_locale(const void *a, const void *b)
 {
     return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
 }
 
-#ifdef USE_THREADS
-static void
-unlock_condpair(svv)
-void *svv;
-{
-    dTHR;
-    MAGIC *mg = mg_find((SV*)svv, 'm');
-    
-    if (!mg)
-	croak("panic: unlock_condpair unlocking non-mutex");
-    MUTEX_LOCK(MgMUTEXP(mg));
-    if (MgOWNER(mg) != thr)
-	croak("panic: unlock_condpair unlocking mutex that we don't own");
-    MgOWNER(mg) = 0;
-    COND_SIGNAL(MgOWNERCONDP(mg));
-    MUTEX_UNLOCK(MgMUTEXP(mg));
-}
-#endif /* USE_THREADS */
-
 PP(pp_reset)
 {
-    dSP;
-#ifdef USE_THREADS
-    dTOPss;
-    MAGIC *mg;
-    
-    if (MAXARG < 1)
-	croak("reset requires mutex argument with USE_THREADS");
-    if (SvROK(sv)) {
-	/*
-	 * Kludge to allow lock of real objects without requiring
-	 * to pass in every type of argument by explicit reference.
-	 */
-	sv = SvRV(sv);
-    }
-    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;
-	MUTEX_UNLOCK(MgMUTEXP(mg));
-	save_destructor(unlock_condpair, sv);
-    }
-    RETURN;
-#else
+    djSP;
     char *tmps;
 
     if (MAXARG < 1)
@@ -1329,7 +1253,6 @@ PP(pp_reset)
     sv_reset(tmps, curcop->cop_stash);
     PUSHs(&sv_yes);
     RETURN;
-#endif /* USE_THREADS */
 }
 
 PP(pp_lineseq)
@@ -1390,7 +1313,7 @@ PP(pp_scope)
 
 PP(pp_enteriter)
 {
-    dSP; dMARK;
+    djSP; dMARK;
     register CONTEXT *cx;
     I32 gimme = GIMME_V;
     SV **svp;
@@ -1422,7 +1345,7 @@ PP(pp_enteriter)
 
 PP(pp_enterloop)
 {
-    dSP;
+    djSP;
     register CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -1438,7 +1361,7 @@ PP(pp_enterloop)
 
 PP(pp_leaveloop)
 {
-    dSP;
+    djSP;
     register CONTEXT *cx;
     struct block_loop cxloop;
     I32 gimme;
@@ -1479,7 +1402,7 @@ PP(pp_leaveloop)
 
 PP(pp_return)
 {
-    dSP; dMARK;
+    djSP; dMARK;
     I32 cxix;
     register CONTEXT *cx;
     struct block_sub cxsub;
@@ -1555,7 +1478,7 @@ PP(pp_return)
 
 PP(pp_last)
 {
-    dSP;
+    djSP;
     I32 cxix;
     register CONTEXT *cx;
     struct block_loop cxloop;
@@ -1688,11 +1611,7 @@ PP(pp_redo)
 static OP* lastgotoprobe;
 
 static OP *
-dofindlabel(o,label,opstack,oplimit)
-OP *o;
-char *label;
-OP **opstack;
-OP **oplimit;
+dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
 {
     OP *kid;
     OP **ops = opstack;
@@ -1741,7 +1660,7 @@ PP(pp_dump)
 
 PP(pp_goto)
 {
-    dSP;
+    djSP;
     OP *retop = 0;
     I32 ix;
     register CONTEXT *cx;
@@ -1788,8 +1707,10 @@ PP(pp_goto)
 		EXTEND(stack_sp, items); /* @_ could have been extended. */
 		Copy(AvARRAY(av), stack_sp, items, SV*);
 		stack_sp += items;
+#ifndef USE_THREADS
 		SvREFCNT_dec(GvAV(defgv));
 		GvAV(defgv) = cx->blk_sub.savearray;
+#endif /* USE_THREADS */
 		AvREAL_off(av);
 		av_clear(av);
 	    }
@@ -1872,15 +1793,34 @@ PP(pp_goto)
 			svp = AvARRAY(padlist);
 		    }
 		}
+#ifdef USE_THREADS
+		if (!cx->blk_sub.hasargs) {
+		    AV* av = (AV*)curpad[0];
+		    
+		    items = AvFILL(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)]);
-		if (cx->blk_sub.hasargs) {
+#ifndef USE_THREADS
+		if (cx->blk_sub.hasargs)
+#endif /* USE_THREADS */
+		{
 		    AV* av = (AV*)curpad[0];
 		    SV** ary;
 
+#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) {
@@ -1905,7 +1845,7 @@ PP(pp_goto)
 			mark++;
 		    }
 		}
-		if (perldb && curstash != debstash) {
+		if (PERLDB_SUB && curstash != debstash) {
 		    /*
 		     * We do not care about using sv to call CV;
 		     * it's for informational purposes only.
@@ -1993,6 +1933,11 @@ PP(pp_goto)
 	    OP *oldop = op;
 	    for (ix = 1; enterops[ix]; ix++) {
 		op = enterops[ix];
+		/* Eventually we may want to stack the needed arguments
+		 * for each op.  For now, we punt on the hard ones. */
+		if (op->op_type == OP_ENTERITER)
+		    DIE("Can't \"goto\" into the middle of a foreach loop",
+			label);
 		(*op->op_ppaddr)(ARGS);
 	    }
 	    op = oldop;
@@ -2022,7 +1967,7 @@ PP(pp_goto)
 
 PP(pp_exit)
 {
-    dSP;
+    djSP;
     I32 anum;
 
     if (MAXARG < 1)
@@ -2042,7 +1987,7 @@ PP(pp_exit)
 #ifdef NOTYET
 PP(pp_nswitch)
 {
-    dSP;
+    djSP;
     double value = SvNVx(GvSV(cCOP->cop_gv));
     register I32 match = I_32(value);
 
@@ -2061,7 +2006,7 @@ PP(pp_nswitch)
 
 PP(pp_cswitch)
 {
-    dSP;
+    djSP;
     register I32 match;
 
     if (multiline)
@@ -2082,9 +2027,7 @@ PP(pp_cswitch)
 /* Eval. */
 
 static void
-save_lines(array, sv)
-AV *array;
-SV *sv;
+save_lines(AV *array, SV *sv)
 {
     register char *s = SvPVX(sv);
     register char *send = SvPVX(sv) + SvCUR(sv);
@@ -2108,8 +2051,7 @@ SV *sv;
 }
 
 static OP *
-docatch(o)
-OP *o;
+docatch(OP *o)
 {
     dTHR;
     int ret;
@@ -2148,25 +2090,16 @@ OP *o;
     return Nullop;
 }
 
+/* With USE_THREADS, eval_owner must be held on entry to doeval */
 static OP *
-doeval(gimme)
-int gimme;
+doeval(int gimme)
 {
-    dTHR;
     dSP;
     OP *saveop = op;
     HV *newstash;
     CV *caller;
     AV* comppadlist;
 
-#ifdef USE_THREADS
-    MUTEX_LOCK(&eval_mutex);
-    if (eval_owner && eval_owner != thr)
-	while (eval_owner)
-	    COND_WAIT(&eval_cond, &eval_mutex);
-    eval_owner = thr;
-    MUTEX_UNLOCK(&eval_mutex);
-#endif /* USE_THREADS */
     in_eval = 1;
 
     PUSHMARK(SP);
@@ -2188,22 +2121,22 @@ int gimme;
     CvUNIQUE_on(compcv);
 #ifdef USE_THREADS
     CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
-    COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
     comppad = newAV();
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
+    min_intro_pending = 0;
+    padix = 0;
 #ifdef USE_THREADS
     av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);	/* XXX Needed? */
 #endif /* USE_THREADS */
-    min_intro_pending = 0;
-    av_push(comppad, Nullsv);
-    curpad = AvARRAY(comppad);
-    padix = 0;
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -2238,7 +2171,7 @@ int gimme;
     if (saveop->op_flags & OPf_SPECIAL)
 	in_eval |= 4;
     else
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
     if (yyparse() || error_count || !eval_root) {
 	SV **newsp;
 	I32 gimme;
@@ -2257,11 +2190,17 @@ int gimme;
 	lex_end();
 	LEAVE;
 	if (optype == OP_REQUIRE) {
-	    char* msg = SvPVx(GvSV(errgv), na);
+	    char* msg = SvPV(errsv, na);
 	    DIE("%s", *msg ? msg : "Compilation failed in require");
 	}
 	SvREFCNT_dec(rs);
 	rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+	MUTEX_LOCK(&eval_mutex);
+	eval_owner = 0;
+	COND_SIGNAL(&eval_cond);
+	MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
 	RETPUSHUNDEF;
     }
     SvREFCNT_dec(rs);
@@ -2278,7 +2217,7 @@ int gimme;
     DEBUG_x(dump_eval());
 
     /* Register with debugger: */
-    if (perldb && saveop->op_type == OP_REQUIRE) {
+    if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
 	CV *cv = perl_get_cv("DB::postponed", FALSE);
 	if (cv) {
 	    dSP;
@@ -2293,6 +2232,7 @@ int gimme;
 
     CvDEPTH(compcv) = 1;
     SP = stack_base + POPMARK;		/* pop original mark */
+    op = saveop;					/* The caller may need it. */
 #ifdef USE_THREADS
     MUTEX_LOCK(&eval_mutex);
     eval_owner = 0;
@@ -2305,7 +2245,7 @@ int gimme;
 
 PP(pp_require)
 {
-    dSP;
+    djSP;
     register CONTEXT *cx;
     SV *sv;
     char *name;
@@ -2341,6 +2281,9 @@ PP(pp_require)
 #ifdef DOSISH
       || (name[0] && name[1] == ':')
 #endif
+#ifdef WIN32
+      || (name[0] == '\\' && name[1] == '\\')	/* UNC path */
+#endif
 #ifdef VMS
 	|| (strchr(name,':')  || ((*name == '[' || *name == '<') &&
 	    (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
@@ -2386,10 +2329,21 @@ PP(pp_require)
     if (!tryrsfp) {
 	if (op->op_type == OP_REQUIRE) {
 	    SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
+	    SV *dirmsgsv = NEWSV(0, 0);
+	    AV *ar = GvAVn(incgv);
+	    I32 i;
 	    if (instr(SvPVX(msg), ".h "))
 		sv_catpv(msg, " (change .h to .ph maybe?)");
 	    if (instr(SvPVX(msg), ".ph "))
 		sv_catpv(msg, " (did you run h2ph?)");
+	    sv_catpv(msg, " (@INC contains:");
+	    for (i = 0; i <= AvFILL(ar); i++) {
+		char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+		sv_setpvf(dirmsgsv, " %s", dir);
+	        sv_catsv(msg, dirmsgsv);
+	    }
+	    sv_catpvn(msg, ")", 1);
+    	    SvREFCNT_dec(dirmsgsv);
 	    DIE("%_", msg);
 	}
 
@@ -2423,6 +2377,14 @@ PP(pp_require)
     compiling.cop_line = 0;
 
     PUTBACK;
+#ifdef USE_THREADS
+    MUTEX_LOCK(&eval_mutex);
+    if (eval_owner && eval_owner != thr)
+	while (eval_owner)
+	    COND_WAIT(&eval_cond, &eval_mutex);
+    eval_owner = thr;
+    MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
     return DOCATCH(doeval(G_SCALAR));
 }
 
@@ -2433,7 +2395,7 @@ PP(pp_dofile)
 
 PP(pp_entereval)
 {
-    dSP;
+    djSP;
     register CONTEXT *cx;
     dPOPss;
     I32 gimme = GIMME_V, was = sub_generation;
@@ -2472,11 +2434,20 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
-    if (perldb && curstash != debstash)
+    if (PERLDB_LINE && curstash != debstash)
 	save_lines(GvAV(compiling.cop_filegv), linestr);
     PUTBACK;
+#ifdef USE_THREADS
+    MUTEX_LOCK(&eval_mutex);
+    if (eval_owner && eval_owner != thr)
+	while (eval_owner)
+	    COND_WAIT(&eval_cond, &eval_mutex);
+    eval_owner = thr;
+    MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
     ret = doeval(gimme);
-    if (perldb && was != sub_generation) { /* Some subs defined here. */
+    if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */
+	&& ret != op->op_next) {	/* Successive compilation. */
 	strcpy(safestr, "_<(eval )");	/* Anything fake and short. */
     }
     return DOCATCH(ret);
@@ -2484,7 +2455,7 @@ PP(pp_entereval)
 
 PP(pp_leaveeval)
 {
-    dSP;
+    djSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -2525,6 +2496,36 @@ PP(pp_leaveeval)
     }
     curpm = newpm;	/* Don't pop $1 et al till now */
 
+    /*
+     * 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
+     */
+    if (AvFILL(comppad_name) >= 0) {
+	SV **svp = AvARRAY(comppad_name);
+	I32 ix;
+	for (ix = AvFILL(comppad_name); ix >= 0; ix--) {
+	    SV *sv = svp[ix];
+	    if (sv && sv != &sv_undef && *SvPVX(sv) == '&') {
+		SvREFCNT_dec(sv);
+		svp[ix] = &sv_undef;
+
+		sv = curpad[ix];
+		if (CvCLONE(sv)) {
+		    SvREFCNT_dec(CvOUTSIDE(sv));
+		    CvOUTSIDE(sv) = Nullcv;
+		}
+		else {
+		    SvREFCNT_dec(sv);
+		    sv = NEWSV(0,0);
+		    SvPADTMP_on(sv);
+		    curpad[ix] = sv;
+		}
+	    }
+	}
+    }
+
 #ifdef DEBUGGING
     assert(CvDEPTH(compcv) == 1);
 #endif
@@ -2543,14 +2544,14 @@ PP(pp_leaveeval)
     LEAVE;
 
     if (!(save_flags & OPf_SPECIAL))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
     RETURNOP(retop);
 }
 
 PP(pp_entertry)
 {
-    dSP;
+    djSP;
     register CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -2563,14 +2564,14 @@ PP(pp_entertry)
     eval_root = op;		/* Only needed so that goto works right. */
 
     in_eval = 1;
-    sv_setpv(GvSV(errgv),"");
+    sv_setpv(errsv,"");
     PUTBACK;
     return DOCATCH(op->op_next);
 }
 
 PP(pp_leavetry)
 {
-    dSP;
+    djSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -2611,13 +2612,12 @@ PP(pp_leavetry)
     curpm = newpm;	/* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(GvSV(errgv),"");
+    sv_setpv(errsv,"");
     RETURN;
 }
 
 static void
-doparseform(sv)
-SV *sv;
+doparseform(SV *sv)
 {
     STRLEN len;
     register char *s = SvPV_force(sv, len);
@@ -2793,3 +2793,4 @@ SV *sv;
     sv_magic(sv, Nullsv, 'f', Nullch, 0);
     SvCOMPILED_on(sv);
 }
+