X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=cc6f13c9b9a7e8960e52885cd68702afc09e952f;hb=c4fbe2471f42249bd57e1c071c99349d2331aea5;hp=8a320173ec6a5e0999a67b1d486c303eb5c90d1c;hpb=e4090ce886275aecfe2478d139a6e0a7781d824e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/scope.c b/scope.c
index 8a32017..cc6f13c 100644
--- a/scope.c
+++ b/scope.c
@@ -50,20 +50,12 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
 SV**
 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
 {
-#if defined(DEBUGGING) && !defined(USE_THREADS)
-    static int growing = 0;
-    if (growing++)
-      abort();
-#endif
     PL_stack_sp = sp;
 #ifndef STRESS_REALLOC
     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
 #else
     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
 #endif
-#if defined(DEBUGGING) && !defined(USE_THREADS)
-    growing--;
-#endif
     return PL_stack_sp;
 }
 
@@ -196,17 +188,21 @@ S_save_scalar_at(pTHX_ SV **sptr)
 	if (SvGMAGICAL(osv)) {
 	    MAGIC* mg;
 	    bool oldtainted = PL_tainted;
-	    mg_get(osv);
-	    if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) {
+	    mg_get(osv);		/* note, can croak! */
+	    if (PL_tainting && PL_tainted &&
+			(mg = mg_find(osv, PERL_MAGIC_taint))) {
 		SAVESPTR(mg->mg_obj);
 		mg->mg_obj = osv;
 	    }
 	    SvFLAGS(osv) |= (SvFLAGS(osv) &
-		(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+               (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 	    PL_tainted = oldtainted;
 	}
 	SvMAGIC(sv) = SvMAGIC(osv);
 	SvFLAGS(sv) |= SvMAGICAL(osv);
+	/* XXX SvMAGIC() is *shared* between osv and sv.  This can
+	 * lead to coredumps when both SVs are destroyed without one
+	 * of their SvMAGIC() slots being NULLed. */
 	PL_localizing = 1;
 	SvSETMAGIC(sv);
 	PL_localizing = 0;
@@ -454,7 +450,7 @@ Perl_save_padsv(pTHX_ PADOFFSET off)
 SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     SV **svp = &THREADSV(i);	/* XXX Change to save by offset */
     DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
 			  (UV)i, svp, *svp, SvPEEK(*svp)));
@@ -463,7 +459,7 @@ Perl_save_threadsv(pTHX_ PADOFFSET i)
 #else
     Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
     return 0;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 }
 
 void
@@ -501,6 +497,14 @@ Perl_save_freesv(pTHX_ SV *sv)
 }
 
 void
+Perl_save_mortalizesv(pTHX_ SV *sv)
+{
+    SSCHECK(2);
+    SSPUSHPTR(sv);
+    SSPUSHINT(SAVEt_MORTALIZESV);
+}
+
+void
 Perl_save_freeop(pTHX_ OP *o)
 {
     SSCHECK(2);
@@ -678,12 +682,19 @@ Perl_leave_scope(pTHX_ I32 base)
 		SvMAGICAL_off(sv);
 		SvMAGIC(sv) = 0;
 	    }
+	    /* XXX This branch is pretty bogus.  This code irretrievably
+	     * clears(!) the magic on the SV (either to avoid further
+	     * croaking that might ensue when the SvSETMAGIC() below is
+	     * called, or to avoid two different SVs pointing at the same
+	     * SvMAGIC()).  This needs a total rethink.  --GSAR */
 	    else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
 		     SvTYPE(value) != SVt_PVGV)
 	    {
 		SvFLAGS(value) |= (SvFLAGS(value) &
-				   (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+                                  (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 		SvMAGICAL_off(value);
+		/* XXX this is a leak when we get here because the
+		 * mg_get() in save_scalar_at() croaked */
 		SvMAGIC(value) = 0;
 	    }
             SvREFCNT_dec(sv);
@@ -793,6 +804,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    SvREFCNT_dec((SV*)ptr);
 	    break;
+	case SAVEt_MORTALIZESV:
+	    ptr = SSPOPPTR;
+	    sv_2mortal((SV*)ptr);
+	    break;
 	case SAVEt_FREEOP:
 	    ptr = SSPOPPTR;
 	    if (PL_comppad)
@@ -852,7 +867,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
 	    SvREFCNT_dec(hv);
-	    Safefree(ptr);
+	    Safefree(ptr); 
 	    break;
 	case SAVEt_DESTRUCTOR:
 	    ptr = SSPOPPTR;
@@ -860,7 +875,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = SSPOPPTR;
-	    (*SSPOPDXPTR)(aTHXo_ ptr);
+	    (*SSPOPDXPTR)(aTHX_ ptr);
 	    break;
 	case SAVEt_REGCONTEXT:
 	case SAVEt_ALLOC:
@@ -879,7 +894,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    if (ptr) {
 		sv = *(SV**)ptr;
 		if (sv && sv != &PL_sv_undef) {
-		    if (SvTIED_mg((SV*)av, 'P'))
+		    if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(sv);
 		    SvREFCNT_dec(av);
 		    goto restore_sv;
@@ -897,7 +912,7 @@ Perl_leave_scope(pTHX_ I32 base)
 		SV *oval = HeVAL((HE*)ptr);
 		if (oval && oval != &PL_sv_undef) {
 		    ptr = &HeVAL((HE*)ptr);
-		    if (SvTIED_mg((SV*)hv, 'P'))
+		    if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(*(SV**)ptr);
 		    SvREFCNT_dec(hv);
 		    SvREFCNT_dec(sv);
@@ -912,10 +927,6 @@ Perl_leave_scope(pTHX_ I32 base)
 	    PL_op = (OP*)SSPOPPTR;
 	    break;
 	case SAVEt_HINTS:
-	    if (GvHV(PL_hintgv)) {
-		SvREFCNT_dec((SV*)GvHV(PL_hintgv));
-		GvHV(PL_hintgv) = NULL;
-	    }
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
 	    break;
 	case SAVEt_COMPPAD: