From: Perl 5 Porters <perl5-porters@africa.nicoh.com>
Date: Sun, 1 Sep 1996 22:00:43 +0000 (+0000)
Subject: perl 5.003_04: dump.c gv.c op.c pp_ctl.c pp_sys.c proto.h run.c
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f967eb5f7ea656df97e47541e42689728310e560;p=p5sagit%2Fp5-mst-13.2.git

perl 5.003_04: dump.c gv.c op.c pp_ctl.c pp_sys.c proto.h run.c

This patch changes neither behavior nor performance.  However, it does
reduce code size and improve maintainability by combining some common
code in gv_fullname() and gv_efullname().
---

diff --git a/dump.c b/dump.c
index a490383..4c00ad3 100644
--- a/dump.c
+++ b/dump.c
@@ -67,7 +67,7 @@ GV* gv;
 {
     SV *sv = sv_newmortal();
 
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
 	dump("(xsub 0x%x %d)\n",
@@ -85,7 +85,7 @@ GV* gv;
 {
     SV *sv = sv_newmortal();
 
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("\nFORMAT %s = ", SvPVX(sv));
     if (CvROOT(GvFORM(gv)))
 	dump_op(CvROOT(GvFORM(gv)));
@@ -223,7 +223,7 @@ register OP *op;
 	    ENTER;
 	    tmpsv = NEWSV(0,0);
 	    SAVEFREESV(tmpsv);
-	    gv_fullname(tmpsv,cGVOP->op_gv);
+	    gv_fullname(tmpsv, cGVOP->op_gv, Nullch);
 	    dump("GV = %s\n", SvPV(tmpsv, na));
 	    LEAVE;
 	}
@@ -309,10 +309,10 @@ register GV *gv;
     sv = sv_newmortal();
     dumplvl++;
     PerlIO_printf(Perl_debug_log, "{\n");
-    gv_fullname(sv,gv);
+    gv_fullname(sv, gv, Nullch);
     dump("GV_NAME = %s", SvPVX(sv));
     if (gv != GvEGV(gv)) {
-	gv_efullname(sv,GvEGV(gv));
+	gv_efullname(sv, GvEGV(gv), Nullch);
 	dump("-> %s", SvPVX(sv));
     }
     dump("\n");
diff --git a/gv.c b/gv.c
index cb38bad..455e785 100644
--- a/gv.c
+++ b/gv.c
@@ -687,38 +687,32 @@ I32 sv_type;
 }
 
 void
-gv_fullname(sv,gv)
+gv_fullname(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
     HV *hv = GvSTASH(gv);
-
-    if (!hv)
+    if (!hv) {
+	SvOK_off(sv);
 	return;
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
+    }
+    sv_setpv(sv, prefix ? prefix : "");
     sv_catpv(sv,HvNAME(hv));
     sv_catpvn(sv,"::", 2);
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
 }
 
 void
-gv_efullname(sv,gv)
+gv_efullname(sv, gv, prefix)
 SV *sv;
 GV *gv;
+char *prefix;
 {
-    GV* egv = GvEGV(gv);
-    HV *hv;
-    
+    GV *egv = GvEGV(gv);
     if (!egv)
 	egv = gv;
-    hv = GvSTASH(egv);
-    if (!hv)
-	return;
-
-    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
-    sv_catpv(sv,HvNAME(hv));
-    sv_catpvn(sv,"::", 2);
-    sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
+    gv_fullname(sv, egv, prefix);
 }
 
 IO *
diff --git a/op.c b/op.c
index d008533..9ee7e29 100644
--- a/op.c
+++ b/op.c
@@ -49,7 +49,7 @@ CvNAME(cv)
 CV* cv;
 {
     SV* tmpsv = sv_newmortal();
-    gv_efullname(tmpsv, CvGV(cv));
+    gv_efullname(tmpsv, CvGV(cv), Nullch);
     return SvPV(tmpsv,na);
 }
 
@@ -2975,7 +2975,7 @@ OP *block;
 	sv_catpv(sv,"-");
 	sprintf(buf,"%ld",(long)curcop->cop_line);
 	sv_catpv(sv,buf);
-	gv_efullname(tmpstr,gv);
+	gv_efullname(tmpstr, gv, Nullch);
 	hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
     }
     op_free(op);
diff --git a/pp_ctl.c b/pp_ctl.c
index b48feb1..f533215 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -574,7 +574,7 @@ PP(pp_sort)
 	    if (!(cv && CvROOT(cv))) {
 		if (gv) {
 		    SV *tmpstr = sv_newmortal();
-		    gv_efullname(tmpstr, gv);
+		    gv_efullname(tmpstr, gv, Nullch);
 		    if (cv && CvXSUB(cv))
 			DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr));
 		    DIE("Undefined sort subroutine \"%s\" called",
@@ -1114,7 +1114,7 @@ PP(pp_caller)
 	RETURN;
     if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
 	sv = NEWSV(49, 0);
-	gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
+	gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch);
 	PUSHs(sv_2mortal(sv));
 	PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
     }
@@ -1623,7 +1623,7 @@ PP(pp_goto)
 	    if (!CvROOT(cv) && !CvXSUB(cv)) {
 		if (CvGV(cv)) {
 		    SV *tmpstr = sv_newmortal();
-		    gv_efullname(tmpstr, CvGV(cv));
+		    gv_efullname(tmpstr, CvGV(cv), Nullch);
 		    DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
 		}
 		DIE("Goto undefined subroutine");
@@ -1760,12 +1760,13 @@ PP(pp_goto)
 			mark++;
 		    }
 		}
-		if (perldb && curstash != debstash) { /* &xsub is not copying @_ */
+		if (perldb && curstash != debstash) {
+		    /* &xsub is not copying @_ */
 		    SV *sv = GvSV(DBsub);
 		    save_item(sv);
-		    gv_efullname(sv, CvGV(cv)); /* We do not care about
-						 * using sv to call CV,
-						 * just for info. */
+		    gv_efullname(sv, CvGV(cv), Nullch);
+		    /* We do not care about using sv to call CV,
+		     * just for info. */
 		}
 		RETURNOP(CvSTART(cv));
 	    }
diff --git a/pp_sys.c b/pp_sys.c
index 0e44eee..9d962d0 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -748,7 +748,7 @@ PP(pp_select)
     else {
 	GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
 	if (gvp && *gvp == egv)
-	    gv_efullname(TARG, defoutgv);
+	    gv_efullname(TARG, defoutgv, Nullch);
 	else
 	    sv_setsv(TARG, sv_2mortal(newRV((SV*)egv)));
 	XPUSHTARG;
@@ -842,7 +842,7 @@ PP(pp_enterwrite)
     if (!cv) {
 	if (fgv) {
 	    SV *tmpsv = sv_newmortal();
-	    gv_efullname(tmpsv, gv);
+	    gv_efullname(tmpsv, fgv, Nullch);
 	    DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
 	}
 	DIE("Not a format reference");
@@ -921,7 +921,7 @@ PP(pp_leavewrite)
 	cv = GvFORM(fgv);
 	if (!cv) {
 	    SV *tmpsv = sv_newmortal();
-	    gv_efullname(tmpsv, fgv);
+	    gv_efullname(tmpsv, fgv, Nullch);
 	    DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
 	}
 	return doform(cv,gv,op);
@@ -978,7 +978,7 @@ PP(pp_prtf)
 	gv = defoutgv;
     if (!(io = GvIO(gv))) {
 	if (dowarn) {
-	    gv_fullname(sv,gv);
+	    gv_fullname(sv, gv, Nullch);
 	    warn("Filehandle %s never opened", SvPV(sv,na));
 	}
 	SETERRNO(EBADF,RMS$_IFI);
@@ -986,7 +986,7 @@ PP(pp_prtf)
     }
     else if (!(fp = IoOFP(io))) {
 	if (dowarn)  {
-	    gv_fullname(sv,gv);
+	    gv_fullname(sv, gv, Nullch);
 	    if (IoIFP(io))
 		warn("Filehandle %s opened only for input", SvPV(sv,na));
 	    else
diff --git a/proto.h b/proto.h
index 92e51f6..df537e9 100644
--- a/proto.h
+++ b/proto.h
@@ -125,12 +125,12 @@ GV*	gv_AVadd _((GV* gv));
 GV*	gv_HVadd _((GV* gv));
 GV*	gv_IOadd _((GV* gv));
 void	gv_check _((HV* stash));
-void	gv_efullname _((SV* sv, GV* gv));
+void	gv_efullname _((SV *sv, GV *gv, char *prefix));
 GV*	gv_fetchfile _((char* name));
 GV*	gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
 GV*	gv_fetchmethod _((HV* stash, char* name));
 GV*	gv_fetchpv _((char* name, I32 add, I32 sv_type));
-void	gv_fullname _((SV* sv, GV* gv));
+void	gv_fullname _((SV *sv, GV *gv, char *prefix));
 void	gv_init _((GV *gv, HV *stash, char *name, STRLEN len, int multi));
 HV*	gv_stashpv _((char* name, I32 create));
 HV*	gv_stashpvn _((char* name, U32 namelen, I32 create));
diff --git a/run.c b/run.c
index 697c7d2..5529fb6 100644
--- a/run.c
+++ b/run.c
@@ -71,7 +71,7 @@ OP *op;
     case OP_GV:
 	if (cGVOP->op_gv) {
 	    sv = NEWSV(0,0);
-	    gv_fullname(sv, cGVOP->op_gv);
+	    gv_fullname(sv, cGVOP->op_gv, Nullch);
 	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
 	    SvREFCNT_dec(sv);
 	}