Re: Debugger code does &SvIVX(...)

[email protected] (Nicholas Clark) Mon, 11 Apr 2005 16:28:10 +0100
Newsgroups perl.perl5.porters,perl.ponie.dev
Message-ID <[email protected]>
On Fri, Apr 08, 2005 at 03:01:53PM +0100, Dave Mitchell wrote:
> On Fri, Apr 08, 2005 at 02:20:56PM +0100, Nicholas Clark wrote:
> > Does anyone understand why/how the debugger code wants to save the value
> > of the IV slot inside an IV? Both are conditional on PERLDB_SUB_NN being
> > true:
> 
> Presumably in the presence of PERLDB_SUB_NN, $DB::sub stores the address
> of the current CV rather than its name. The old value has to be saved so
> that on exit from the sub, the old value is retored.
>  
> > Is doing this even legal? Can the SV * in question get upgraded further, and
> > thus that saved memory location stop being the location of SV's IV?
> 
> Yes, looks highy illegal.
> 
> > Should we add a new save type that takes the pointer to an SV and saves/
> > restores the IV slot?
> 
> Or maybe just use save_item() like the other branch does?

I checked in change 24228 to fix this. I tried several approaches, and
picked the one that's described as 24222IVtup below. Timings are for

time ../../../perl -I ../../../lib -d:DProf ../bin/enc2xs -Q -o wibble `cat *.fnm`

running in ext/Encode/CN

244222IVtup seemed to be the fastest. The slightly more complex 244222IVtup+
which attempted to avoid upgrading to PVIV where possible seemed to be slower.
My guess is that after the first restore of saveitem, $DB::sub becomes a
SVt_IV, and so it won't need to get upgraded to SVt_PVIV.
(see the patches for the upgrades I'm talking about. If anyone wants to play
along at home)

Nicholas Clark

====24222IVt====
real    0m5.506s
user    0m5.120s
sys     0m0.280s

real    0m5.349s
user    0m5.000s
sys     0m0.320s

real    0m5.304s
user    0m5.040s
sys     0m0.250s
--- perl.c.orig	2005-04-05 22:58:22.000000000 +0100
+++ perl.c	2005-04-11 11:00:09.000000000 +0100
@@ -3906,7 +3906,6 @@ Perl_init_debugger(pTHX)
     PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
-    sv_upgrade(GvSV(PL_DBsub), SVt_IV);	/* IVX accessed if PERLDB_SUB_Ntime ../../../perl -I ../../../lib -d:DProf ../bin/enc2xs -Q -oN */
     PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
     PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
--- pp_ctl.c.orig	2005-04-08 12:59:54.000000000 +0100
+++ pp_ctl.c	2005-04-11 11:02:37.000000000 +0100
@@ -2427,9 +2427,11 @@ PP(pp_goto)
 		    CV *gotocv;
 
 		    if (PERLDB_SUB_NN) {
-			(void)SvUPGRADE(sv, SVt_PVIV);
+			int type = SvTYPE(sv);
+			if (type < SVt_PVIV && type != SVt_IV)
+			    sv_upgrade(sv, SVt_PVIV);
 			(void)SvIOK_on(sv);
-			SAVEIV(SvIVX(sv));
+			save_item(sv);
 			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
 		    } else {
 			save_item(sv);
--- pp_hot.c.orig	2005-04-10 16:32:15.000000000 +0100
+++ pp_hot.c	2005-04-11 11:36:18.000000000 +0100
@@ -2580,9 +2580,11 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 	}
     }
     else {
-	(void)SvUPGRADE(dbsv, SVt_PVIV);
+	int type = SvTYPE(dbsv);
+	if (type < SVt_PVIV && type != SVt_IV)
+	    sv_upgrade(dbsv, SVt_PVIV);
 	(void)SvIOK_on(dbsv);
-	SAVEIV(SvIVX(dbsv));
+	save_item(dbsv);
 	SvIV_set(dbsv, PTR2IV(cv));	/* Do it the quickest way  */
     }
 
====24222IVtup====
real    0m5.245s
user    0m5.020s
sys     0m0.220s

real    0m5.161s
user    0m4.820s
sys     0m0.340s

real    0m5.404s
user    0m5.080s
sys     0m0.240s
--- perl.c.orig	2005-04-05 22:58:22.000000000 +0100
+++ perl.c	2005-04-11 11:00:09.000000000 +0100
@@ -3906,7 +3906,6 @@ Perl_init_debugger(pTHX)
     PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
-    sv_upgrade(GvSV(PL_DBsub), SVt_IV);	/* IVX accessed if PERLDB_SUB_NN */
     PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
     PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
--- pp_ctl.c.orig	2005-04-08 12:59:54.000000000 +0100
+++ pp_ctl.c	2005-04-11 11:37:17.000000000 +0100
@@ -2426,13 +2426,14 @@ PP(pp_goto)
 		    SV *sv = GvSV(PL_DBsub);
 		    CV *gotocv;
 
+		    save_item(sv);
 		    if (PERLDB_SUB_NN) {
-			(void)SvUPGRADE(sv, SVt_PVIV);
+			int type = SvTYPE(sv);
+			if (type < SVt_PVIV && type != SVt_IV)
+			    sv_upgrade(sv, SVt_PVIV);
 			(void)SvIOK_on(sv);
-			SAVEIV(SvIVX(sv));
 			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
 		    } else {
-			save_item(sv);
 			gv_efullname3(sv, CvGV(cv), Nullch);
 		    }
 		    if (  PERLDB_GOTO
--- pp_hot.c.orig	2005-04-10 16:32:15.000000000 +0100
+++ pp_hot.c	2005-04-11 11:36:55.000000000 +0100
@@ -2560,10 +2560,10 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     SV *dbsv = GvSV(PL_DBsub);
 
+    save_item(dbsv);
     if (!PERLDB_SUB_NN) {
 	GV *gv = CvGV(cv);
 
-	save_item(dbsv);
 	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
 	     || strEQ(GvNAME(gv), "END")
 	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
@@ -2580,9 +2580,10 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 	}
     }
     else {
-	(void)SvUPGRADE(dbsv, SVt_PVIV);
+	int type = SvTYPE(dbsv);
+	if (type < SVt_PVIV && type != SVt_IV)
+	    sv_upgrade(dbsv, SVt_PVIV);
 	(void)SvIOK_on(dbsv);
-	SAVEIV(SvIVX(dbsv));
 	SvIV_set(dbsv, PTR2IV(cv));	/* Do it the quickest way  */
     }
 
====24222IVtup+====
real    0m5.292s
user    0m4.910s
sys     0m0.350s

real    0m5.427s
user    0m5.170s
sys     0m0.230s

real    0m5.405s
user    0m4.910s
sys     0m0.390s
--- perl.c.orig	2005-04-05 22:58:22.000000000 +0100
+++ perl.c	2005-04-11 11:00:09.000000000 +0100
@@ -3906,7 +3906,6 @@ Perl_init_debugger(pTHX)
     PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
-    sv_upgrade(GvSV(PL_DBsub), SVt_IV);	/* IVX accessed if PERLDB_SUB_NN */
     PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
     PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
--- pp_ctl.c.orig	2005-04-08 12:59:54.000000000 +0100
+++ pp_ctl.c	2005-04-11 15:44:43.000000000 +0100
@@ -2426,13 +2426,16 @@ PP(pp_goto)
 		    SV *sv = GvSV(PL_DBsub);
 		    CV *gotocv;
 
+		    save_item(sv);
 		    if (PERLDB_SUB_NN) {
-			(void)SvUPGRADE(sv, SVt_PVIV);
+			int type = SvTYPE(sv);
+			if (type < SVt_IV)
+			    sv_upgrade(sv, SVt_IV);
+			else if (type > SVt_IV && type < SVt_PVIV)
+			    sv_upgrade(sv, SVt_PVIV);
 			(void)SvIOK_on(sv);
-			SAVEIV(SvIVX(sv));
 			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
 		    } else {
-			save_item(sv);
 			gv_efullname3(sv, CvGV(cv), Nullch);
 		    }
 		    if (  PERLDB_GOTO
--- pp_hot.c.orig	2005-04-10 16:32:15.000000000 +0100
+++ pp_hot.c	2005-04-11 15:45:10.000000000 +0100
@@ -2560,10 +2560,10 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     SV *dbsv = GvSV(PL_DBsub);
 
+    save_item(dbsv);
     if (!PERLDB_SUB_NN) {
 	GV *gv = CvGV(cv);
 
-	save_item(dbsv);
 	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
 	     || strEQ(GvNAME(gv), "END")
 	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
@@ -2580,9 +2580,12 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 	}
     }
     else {
-	(void)SvUPGRADE(dbsv, SVt_PVIV);
+	int type = SvTYPE(dbsv);
+	if (type < SVt_IV)
+	    sv_upgrade(dbsv, SVt_IV);
+	else if (type > SVt_IV && type < SVt_PVIV)
+	    sv_upgrade(dbsv, SVt_PVIV);
 	(void)SvIOK_on(dbsv);
-	SAVEIV(SvIVX(dbsv));
 	SvIV_set(dbsv, PTR2IV(cv));	/* Do it the quickest way  */
     }
 
====24222saveitem====
real    0m5.644s
user    0m5.070s
sys     0m0.280s

real    0m5.340s
user    0m5.110s
sys     0m0.260s

real    0m5.376s
user    0m4.920s
sys     0m0.260s
--- pp_ctl.c.orig	2005-04-08 12:59:54.000000000 +0100
+++ pp_ctl.c	2005-04-11 10:23:16.000000000 +0100
@@ -2429,7 +2429,7 @@ PP(pp_goto)
 		    if (PERLDB_SUB_NN) {
 			(void)SvUPGRADE(sv, SVt_PVIV);
 			(void)SvIOK_on(sv);
-			SAVEIV(SvIVX(sv));
+			save_item(sv);
 			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
 		    } else {
 			save_item(sv);
--- pp_hot.c.orig	2005-04-10 16:32:15.000000000 +0100
+++ pp_hot.c	2005-04-11 10:23:35.000000000 +0100
@@ -2582,7 +2582,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
     else {
 	(void)SvUPGRADE(dbsv, SVt_PVIV);
 	(void)SvIOK_on(dbsv);
-	SAVEIV(SvIVX(dbsv));
+	save_item(dbsv);
 	SvIV_set(dbsv, PTR2IV(cv));	/* Do it the quickest way  */
     }